2012-07-19 4 views
-1
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 

2 메일 매크로 한Excel을 결합 포맷하고

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 = "[email protected]" 
    ccto = "[email protected]" 
    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 
+0

같은 당신이 무엇을 시도? 'CommandButton1_Click' 서브에'Macro1'을 추가하는 것은 어떨까요? – assylias

답변

0

아마도이

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 = "[email protected]" 
    ccto = "[email protected]" 
    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 
+0

고맙습니다 !! 너는 내 하루를 만들어 줬어. 너는 사람들이 너무 차갑다. .. 훌륭한 일 .. 고마워 !!!! – user1521934

+0

@ user1521934이 답변이 도움이 될 경우 체크 표시를 클릭하십시오. – IAmBatman