Befehlsschaltflächen erstellen sich selb
27.09.2020 15:00:48
Hartmut
mein VBA Problem ist schon sehr alt. Die Datei ist schon 2012 mit Excel 2010 erstellt. Aber das Problem gab es schon immer. Nun habe ich einiges an der gesamt Datei geändert und das Problem nervt mich so richtig. Immer, wenn das Slript durchläuft entstehen irgendwie zwei weitere Schaltflächen, die ich nicht Programmiert habe. Solange es keine Fehlermeldung gibt, stört es nur wenig. Ich muss halt das Untermakro, dass die Schaltflächen löscht, manchmal anpassen. Hat jemand eine Idee, wie ich diesen Fehler beheben kann?
Im Anhang ein Bild zur Erklärung. Die Datei kann ich auf Grund der vielen senisblen Daten nicht mitliefern, aber hier das Skript:
Sub Wochenmeldung_Buero()
' Wochenmeldung erstellen
' Call Wochenmeldung_drucken
Dim Mailadresse As String, Betreff As String
ActiveWorkbook.Save
Call Aenderung_als_pdf
Sheets("TeilnMo8Uhr").Select
Range("G1") = CDate(InputBox("Datum!"))
Dim olApp As Object
Set olApp = CreateObject("Outlook.Application")
Mailadresse = "rathauskantine-nms@t-online.de ; nchristophersen-kita@kirche-boostedt.de"
Betreff = "Wochenmeldung und Menüplan die Woche vom " & Date + 5 & "bis zum " & Date + 9
Sheets("Wochenmeldung").Range("A1").ClearContents
Text = "Moin," & vbCrLf & "in der Anlage übersenden wir die Wochenmeldung und " _
& "den Menüplan für den Zeitraum vom " & Date + 5 & " bis " & Date + 9 _
& vbCrLf & vbCrLf & "Mit freundlichen Grüßen" _
& vbCrLf & vbCrLf & "Hartmut David" _
& vbCrLf & "Kita-Leitung" _
& vbCrLf _
& vbCrLf & "Diese Email ist vertraulich und kann darueber hinaus persoenliche Inhalte haben. _
" _
& vbCrLf & "Beachten Sie bitte, dass jede Form der unautorisierten Nutzung, Verö _
ffentlichung," _
& vbCrLf & "Vervielfältigung oder Weitergabe des Inhaltes dieser Email nicht gestattet ist." _
_
& vbCrLf & "Diese nachricht ist ausschließlich für den bezeichneten Adressaten oder dessen _
Vertreter" _
& vbCrLf & "bestimmt." _
& vbCrLf & "Sollten Sie nicht der vorgesehene Adressat dieser Email oder dessen Vertreter _
sein, so" _
& vbCrLf & "bitten wir Sie, sich mit dem Absender der Email in Verbindung zu setzen." _
& vbCrLf & "Wir haben diese Email vor dem Versenden auf Virenfreiheit geprüft." _
& vbCrLf & "Eine Haftung für Schäden durch Virenbefall schließen wir aus."
Sheets("Wochenmeldung").ExportAsFixedFormat Type:=xlTypePDF, Filename:="N:\Kita\ _
Scanablage-Team\Wochenmeldung.pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
With olApp.CreateItem(0)
.to = Mailadresse
.Subject = Betreff
.Body = Text
' .Attachments.Add "C:\Tagesmeldung\Wochenmeldung.pdf"
.Attachments.Add "N:\Kita\Scanablage-Team\Wochenmeldung.pdf"
' .Attachments.Add "C:\Tagesmeldung\Menueplan.pdf"
If Len(Dir("N:\Kita\Scanablage-Team\Menueplan.pdf")) > 0 Then
'weiter im Makro
Else
MsgBox "Der Menüplan muss erst eingescannt werden."
Command_Knopf_weg
Exit Sub
End If
.Attachments.Add "N:\Kita\Scanablage-Team\Menueplan.pdf"
' .Attachments.Add "C:\Tagesmeldung\Tagesmeldung.pdf"
.Attachments.Add "N:\Kita\Scanablage-Team\Tagesmeldung.pdf"
.Display
' .Send
End With
Set olApp = Nothing
Sheets("TeilnMo8Uhr").Select
Range("G1").Value = Date - 2
Sheets("Änderungsmeldung").Select
Call Schaltfläche_weg
Call Wochenmeldung_drucken
Name "N:\Kita\Scanablage-Team\Menueplan.pdf" As "N:\Kita\Scanablage-Team\Menueplan.pdf.sik"
Kill "N:\Kita\Scanablage-Team\Menueplan.pdf.sik"
Application.Dialogs(xlDialogSaveAs).Show
End Sub
Sub Wochenmeldung_Pinguine()
' Wochenmeldung erstellen
' Call Wochenmeldung_drucken
Dim Mailadresse As String, Betreff As String
ActiveWorkbook.Save
Call Aenderung_als_pdf_Pinguine
Sheets("TeilnMo8Uhr").Select
Range("G1") = CDate(InputBox("Datum!"))
Dim olApp As Object
Set olApp = CreateObject("Outlook.Application")
Mailadresse = "Caterer@email-adresse.de"
Betreff = "Pinguine Wochenmeldung und Menüplan die Woche vom " & Date + 5 & "bis zum " & _
Date + 9
Sheets("Wochenmeldung").Range("A1").ClearContents
Text = "Moin," & vbCrLf & "in der Anlage übersenden wir die Wochenmeldung und " _
& "den Menüplan für den Zeitraum vom " & Date + 5 & " bis " & Date + 9 _
& vbCrLf & vbCrLf & "Mit freundlichen Grüßen" _
& vbCrLf & vbCrLf & "Hartmut David" _
& vbCrLf & "Kita-Leitung" _
& vbCrLf _
& vbCrLf & "Diese Email ist vertraulich und kann darueber hinaus persoenliche Inhalte haben. _
" _
& vbCrLf & "Beachten Sie bitte, dass jede Form der unautorisierten Nutzung, Verö _
ffentlichung," _
& vbCrLf & "Vervielfältigung oder Weitergabe des Inhaltes dieser Email nicht gestattet ist." _
_
& vbCrLf & "Diese nachricht ist ausschließlich für den bezeichneten Adressaten oder dessen _
Vertreter" _
& vbCrLf & "bestimmt." _
& vbCrLf & "Sollten Sie nicht der vorgesehene Adressat dieser Email oder dessen Vertreter _
sein, so" _
& vbCrLf & "bitten wir Sie, sich mit dem Absender der Email in Verbindung zu setzen." _
& vbCrLf & "Wir haben diese Email vor dem Versenden auf Virenfreiheit geprüft." _
& vbCrLf & "Eine Haftung für Schäden durch Virenbefall schließen wir aus."
Sheets("Wochenmeldung").ExportAsFixedFormat Type:=xlTypePDF, Filename:="N:\Pfad\ _
Wochenmeldung.pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
With olApp.CreateItem(0)
.to = Mailadresse
.Subject = Betreff
.Body = Text
.Attachments.Add "N:\Pfad\Wochenmeldung.pdf"
If Len(Dir("N:\Pfad\Menueplan.pdf")) > 0 Then
'weiter im Makro
Else
MsgBox "Der Menüplan muss erst eingescannt werden."
Command_Knopf_weg
Exit Sub
End If
.Attachments.Add "N:\Pfad\Menueplan.pdf"
.Attachments.Add "N:\Pfad\Tagesmeldung.pdf"
.Display
' .Send
End With
Set olApp = Nothing
Sheets("TeilnMo8Uhr").Select
Range("G1").Value = Date - 2
Sheets("Änderungsmeldung").Select
Call Schaltfläche_weg
Call Wochenmeldung_drucken
Name "N:\Pfad\Menueplan.pdf" As "N:\Scanablage-Team\Menueplan.pdf.sik"
Kill "N:\Pfad\Menueplan.pdf.sik"
Application.Dialogs(xlDialogSaveAs).Show
End Sub