excel - 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