的Excel：將重新格式化和郵件宏

Question

Sub Macro1() 
' 
' Macro1 Macro 
' 
' Keyboard Shortcut: Ctrl+q 
' 
    Rows("1:6").Select 
    Selection.Delete Shift:=xlUp 
    Rows("2:2").Select 
    Selection.Delete Shift:=xlUp 
    Columns("A:A").Select 
    Selection.Delete Shift:=xlToLeft 
    Rows("1:1").Select 
    With Selection.Interior 
     .Pattern = xlSolid 
     .PatternColorIndex = xlAutomatic 
     .ThemeColor = xlThemeColorLight1 
     .TintAndShade = 0.499984740745262 
     .PatternTintAndShade = 0 
    End With 
    With Selection.Font 
     .ThemeColor = xlThemeColorDark1 
     .TintAndShade = 0 
    End With 
    Cells.Select 
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone 
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone 
    With Selection.Borders(xlEdgeLeft) 
     .LineStyle = xlContinuous 
     .ColorIndex = 0 
     .TintAndShade = 0 
     .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeTop) 
     .LineStyle = xlContinuous 
     .ColorIndex = 0 
     .TintAndShade = 0 
     .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeBottom) 
     .LineStyle = xlContinuous 
     .ColorIndex = 0 
     .TintAndShade = 0 
     .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeRight) 
     .LineStyle = xlContinuous 
     .ColorIndex = 0 
     .TintAndShade = 0 
     .Weight = xlThin 
    End With 
    With Selection.Borders(xlInsideVertical) 
     .LineStyle = xlContinuous 
     .ColorIndex = 0 
     .TintAndShade = 0 
     .Weight = xlThin 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
     .LineStyle = xlContinuous 
     .ColorIndex = 0 
     .TintAndShade = 0 
     .Weight = xlThin 
    End With 
    Cells.EntireColumn.AutoFit 
    Rows("1:1").Select 
    Selection.Font.Bold = True 
    Selection.AutoFilter 
End Sub 

第二屆一個

Option Explicit 
Private Sub CommandButton1_Click() 
     sendmail 
End Sub 

Public Function sendmail() 
    On Error GoTo ende 
    Dim esubject As String, sendto As String, ccto As String, ebody As String, newfilename As String 
    Dim apps As Object, itm As Object 

    esubject = "Systematic and Manually Created ASN" 
    sendto = "ooooooo@hp.com" 
    ccto = "iiiiiiii@hp.com" 
    ebody = "Hello All" & vbCrLf & _ 
    "Please find the Systematically and Manually created ASN for the last month" & _ 
     vbCrLf & "With Regards" & vbCrLf & "Tarak" 

    newfilename = "C:\Stuff.XLS" 

    Set apps = CreateObject("Outlook.Application") 
    Set itm = apps.createitem(0) 

    With itm 
     .Subject = esubject 
     .To = sendto 
     .cc = ccto 
     .body = ebody 
     .attachments.Add (newfilename) 
     .display 
     .Send 
    End With 

    Set apps = Nothing 
    Set itm = Nothing 

ende: 

End Function 

Answer 1

也許這樣的事情

Option Explicit 
Private Sub CommandButton1_Click() 
    Rows("1:6").Select 
    Selection.Delete Shift:=xlUp 
    Rows("2:2").Select 
    Selection.Delete Shift:=xlUp 
    Columns("A:A").Select 
    Selection.Delete Shift:=xlToLeft 
    Rows("1:1").Select 
    With Selection.Interior 
     .Pattern = xlSolid 
     .PatternColorIndex = xlAutomatic 
     .ThemeColor = xlThemeColorLight1 
     .TintAndShade = 0.499984740745262 
     .PatternTintAndShade = 0 
    End With 
    With Selection.Font 
     .ThemeColor = xlThemeColorDark1 
     .TintAndShade = 0 
    End With 
    Cells.Select 
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone 
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone 
    With Selection.Borders(xlEdgeLeft) 
     .LineStyle = xlContinuous 
     .ColorIndex = 0 
     .TintAndShade = 0 
     .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeTop) 
     .LineStyle = xlContinuous 
     .ColorIndex = 0 
     .TintAndShade = 0 
     .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeBottom) 
     .LineStyle = xlContinuous 
     .ColorIndex = 0 
     .TintAndShade = 0 
     .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeRight) 
     .LineStyle = xlContinuous 
     .ColorIndex = 0 
     .TintAndShade = 0 
     .Weight = xlThin 
    End With 
    With Selection.Borders(xlInsideVertical) 
     .LineStyle = xlContinuous 
     .ColorIndex = 0 
     .TintAndShade = 0 
     .Weight = xlThin 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
     .LineStyle = xlContinuous 
     .ColorIndex = 0 
     .TintAndShade = 0 
     .Weight = xlThin 
    End With 
    Cells.EntireColumn.AutoFit 
    Rows("1:1").Select 
    Selection.Font.Bold = True 
    Selection.AutoFilter 

    sendmail 
End Sub 

Public Function sendmail() 
    On Error GoTo ende 
    Dim esubject As String, sendto As String, ccto As String, ebody As String, newfilename As String 
    Dim apps As Object, itm As Object 

    esubject = "Systematic and Manually Created ASN" 
    sendto = "ooooooo@hp.com" 
    ccto = "iiiiiiii@hp.com" 
    ebody = "Hello All" & vbCrLf & _ 
    "Please find the Systematically and Manually created ASN for the last month" & _ 
     vbCrLf & "With Regards" & vbCrLf & "Tarak" 

    newfilename = "C:\Stuff.XLS" 

    Set apps = CreateObject("Outlook.Application") 
    Set itm = apps.createitem(0) 

    With itm 
     .Subject = esubject 
     .To = sendto 
     .cc = ccto 
     .body = ebody 
     .attachments.Add (newfilename) 
     .display 
     .Send 
    End With 

    Set apps = Nothing 
    Set itm = Nothing 

ende: 

End Function