Export Worksheet mit Makro und Buttons
03.04.2020 10:12:33
Mark
vorab: meine VBA Kenntnisse sind eher gering. Bisher habe ich den Recorder verwendet und den Code durch Beiträge aus diesem Forum oder aber einem Nachschlagewerk ergänzt.
Ich habe eine Datei mit 12 Tabellenblättern, für jeden Monat eines. Es handelt sich hierbei um eine monatliche Stundenabrechnung von Mitarbeitern. In den jeweiligen Tabellenblättern sind viele Zellen passwortgeschützt, die per Button geöffnet werden, ein Wert eingetragen wird und dann wieder gesperrt werden. Anschließend wird nur das aktive Blatt kopiert, einigige Elemente gelöscht und als .xlsm einer Mail angehängt. Im Tabellenblatt ist ein weiterer Button vorhanden, den der Empfänger der Email betätigen soll (Das war jetzt die verkürzte Darstellung).
Jetzt zum Problem:
Der Code ist in Modulen geschrieben und wird nicht auf das kopierte Tabellenblatt übertragen.
Wenn ich den Code in das jeweilige Tabellenblatt einfüge, wird er zwar mit kopiert, allerdings funktionieren dann die Buttons nicht mehr, da sie sich auf den Code in der "Mutterdatei" beziehen. Hat jemand eine Idee wo ich ansetzen könnte?
Hier der Code der die Datei exportiert:
Sub MailversandMitarbeiter()
ActiveSheet.Unprotect Password:=Range("A78")
Range("C20:F50").Select
Selection.Locked = True
Selection.FormulaHidden = False
Range("C60:D60").Select
ActiveCell.FormulaR1C1 = "Digital signiert durch " & Environ("Username")
Range("A60").Select
ActiveCell.FormulaR1C1 = Date & " - " & Time
ActiveSheet.Protect Password:=Range("A78"), DrawingObjects:=True, Contents:=True, Scenarios: _
_
_
=True
ActiveWorkbook.Save
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:="C:\Users\" & Environ("Username") & "\AppData\Local\ _
Temp\Zeiterfassung " & Range("B7") & ", " & Range("B6") & " ab " & Range("G1") & ".xlsm", _
FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveSheet.Unprotect Password:=Range("A78")
ActiveSheet.Shapes.Range(Array("Button 3")).Select
Selection.Delete
ActiveSheet.Shapes.Range(Array("Button 2")).Select
Selection.Delete
ActiveSheet.Shapes.Range(Array("Button 1")).Select
Selection.Delete
Range("A64:D64").Select
Selection.ClearContents
Range("C68").Select
Selection.ClearContents
Range("C68").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ActiveSheet.Protect Password:=Range("A78"), DrawingObjects:=True, Contents:=True, Scenarios: _
_
_
=True
ActiveWorkbook.Close SaveChanges:=True
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
.GetInspector.Display
olOldBody = .htmlBody
sText = ""
.To = ""
.cc = sCC
.Subject = "Zeiterfassung " & Range("B7").Value & ", " & Range("B6").Value & " ab " _
_
_
& Range("G1").Value
.htmlBody = sText & olOldBody
.Attachments.Add "C:\Users\" & Environ("Username") & "\AppData\Local\Temp\ _
Zeiterfassung " & Range("B7") & ", " & Range("B6") & " ab " & Range("G1") & ".xlsm"
End With
Kill "C:\Users\" & Environ("Username") & "\AppData\Local\Temp\Zeiterfassung " & Range("B7") _
_
_
& ", " & Range("B6") & " ab " & Range("G1") & ".xlsm"
End Sub