Ich habe eine 120+ Blatt Arbeitsmappe, deren Titelseite eine schöne Funktion hat, ein bestimmtes Blatt zu extrahieren, speichern Sie es als ein neues Buch mit einer Reihe von Details. Was alles gut funktioniert. Versuche jedoch, eine neue Funktion hinzuzufügen. Auf dem extrahierten Blatt habe ich eine Schaltfläche hinzugefügt und ein Makro erstellt, das den fertigen Artikel per E-Mail versendet. Das Problem besteht darin, dass die Standortreferenz für das Makro den Standardwert für die ursprüngliche Buchquelle angibt und nicht für das Blatt selbst (alle .XLSM-Dateien). Das Makro selbst befindet sich auf jedem Blatt, aber ich finde keine Möglichkeit, den Bezug für das Makro auf dem Blatt selbst zu fixieren. Und mein Google-Fu hat mich im Stich gelassen. Jede Eingabe oder Worte der Weisheit würden sehr geschätzt werden!definierte Makro-Positionen in Excel
OK, hier ist der Mailer-Makro:
Sub Mail_FinishedSheet_Array()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim OutApp As Object
Dim OutMail As Object
Dim SigString As String
Dim Signature As String
Dim StrBody As String
Set wb1 = ActiveWorkbook
If Val(Application.Version) >= 12 Then
If wb1.FileFormat = 51 And wb1.HasVBProject = True Then
MsgBox "There is VBA code in this xlsx file. There will" & vbNewLine & _
"be no VBA code in the file you send. Save the" & vbNewLine & _
"file as a macro-enabled (. Xlsm) and then retry the macro.", vbInformation
Exit Sub
End If
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Signature details with path
SigString = Environ("appdata") & _
"\Microsoft\Signatures\Zonal2014HO.htm"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
' Make a copy of the file.
' If you want to change the file name then change only TempFileName variable.
TempFilePath = Environ$("temp") & "\"
TempFileName = wb1.Name & " " & Format(Now, "dd-mmm-yy hh-mm")
FileExtStr = "." & LCase(Right(wb1.Name, _
Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))
wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
'Body contents for HTML format e-mail
StrBody = "<BODY style=font-size:11pt;font-family:Calibri>Hi," _
& "<p>Please find a completed checksheet attached for a PC Rebuild." _
& "<p>Regards, " _
& "<p></BODY>"
' Change the mail address and subject in the macro before you run this procedure.
With OutMail
.To = "[email protected]"
.CC = "[email protected]"
.BCC = ""
.Subject = "Completed PC Rebuild Checksheet " & Format(Now, "dd-mmm-yy")
.HTMLbody = StrBody & Signature
.Attachments.Add wb2.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
' In place of the following statement, you can use ".Display" to
' display the mail.
.Display
End With
On Error GoTo 0
wb2.Close SaveChanges:=False
' Delete the file.
' Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Und hier ist die Extraktion Makro aus der Haupt-Seite, die die Wünsche Blatt aus dem Buch trennt und speichert sie als neue Datei:
Sub Full_Extract()
Dim wbkOriginal As Workbook
Set wbkOriginal = ActiveWorkbook
'sets site and engineer details into the estate page that is being extracted
Worksheets(Sheet1.CmbSheet.Value).Range("B3").Value = Worksheets("front page").Range("E6")
Worksheets(Sheet1.CmbSheet.Value).Range("D3").Value = Worksheets("front page").Range("N6")
Worksheets(Sheet1.CmbSheet.Value).Range("F3").Value = Worksheets("front page").Range("K6")
Worksheets(Sheet1.CmbSheet.Value).Range("B4").Value = Worksheets("front page").Range("F8")
Worksheets(Sheet1.CmbSheet.Value).Range("D4").Value = Worksheets("front page").Range("K8")
' copies sheet name from combo box into new document, saves it with site name and current date
' into C:\Temp\ folder for ease of access
With ActiveWorkbook.Sheets(Array((Sheet1.CmbSheet.Value), "Z-MISC"))
.Copy
ActiveWorkbook.SaveAs _
"C:\temp\" _
& ActiveWorkbook.Sheets(Sheet1.CmbSheet.Value).Cells(3, 2).Text _
& " " _
& Format(Now(), "DD-MM-YY") _
& ".xlsm", _
xlOpenXMLWorkbookMacroEnabled, , , , False
End With
'code to close the original workbook to prevent accidental changes etc
Application.DisplayAlerts = False
wbkOriginal.Close
Application.DisplayAlerts = True
End Sub
ah ... nur wenn es einen Code dazu gab. Manchmal sind sie hilfreich. – cyboashu
Das Makro für den Mailer ist ziemlich üblich, und es funktioniert physikalisch (wenn ich nicht eins der Blätter extrahiere und es einfach mache, tut es alles, was es tun soll) es ist nur einmal das Blatt extrahiert, die Position der Knopf zeigt auf 'Checkbook.xlsm'! activesheet.mailsheet - und dann bricht es ab. Ich brauche diese Referenz, um als lokales Blatt zu bleiben. –
Ich würde mit @cyboashu zustimmen, es wird viel einfacher, auf den Grund dieser zu kommen, wenn Sie sogar Teilcode einschließen. –