Am folosit un cod standard de internet pentru a utiliza un buton pentru a crea un e-mail în Outlook cu un atașament, care este o serie în foaia de lucru în cazul în care butonul este apăsat.Codul funcționează foarte bine. Cum pot prelungi durata de cod pentru a îmbina două sau mai multe game? În codul de mai jos, am început deja inițializarea o a doua Sursă și Dest, dar apoi a pierdut încrederea cu privire la cum ar trebui să fie aplicate.
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