내가 사용한 어떤 표준 코드를 인터넷에서 사용하는 버튼을 만들어 이메일에 Outlook 첨부 파일이 있는 범위에서 워크시트가 버튼을 눌렀습니다.코드는 아름답게 작동합니다. 할 수 있는 방법을 확장 코드를 연결하는 두 개 이상의 범위는? 아래 코드에서는 내가 이미 시작 초기화 번째 소스 및 대상이지만,그런 자신감을 잃는 방법에 대한 이 적용되어야 합니다.
Private Sub CommandButton2_Click()
Dim Source As Range
Dim Source2 As Range
Dim Dest As Workbook
Dim Dest2 As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim AutoPrint As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object
Set Source = Nothing
Set Source2 = Nothing
On Error Resume Next
Set Source = Range("A1:M47").SpecialCells(xlCellTypeVisible)
Set Source2 = Range("AB1:AN47").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Set Dest2 = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With
If Range("AC6") <> "" Then
Source2.Copy
With Dest2.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With
End If
TempFilePath = Environ$("temp") & "\"
TempFileName = "Selection of " & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2016
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
AutoPrint = Range("Y6").Value
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.to = Range("S6").Value
.CC = Range("S3").Value
If Range("T3").Value = "Enter bcc addresses manually here" Then
.bcc = ""
Else
.bcc = Range("T3").Value
End If
.Subject = Range("V6").Value
.Body = Range("U6").Value
.Attachments.Add Dest.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
If AutoPrint = "Yes" Then
.Send 'or use .Display
Else
.Display
End If
End With
On Error GoTo 0
.Close savechanges:=False
End With
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub