Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Befehlsschaltflächen erstellen sich selb

Betrifft: Befehlsschaltflächen erstellen sich selb von: Hartmut
Geschrieben am: 27.09.2020 15:00:48

Moin,
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

Betrifft: AW: Befehlsschaltflächen erstellen sich selb
von: Daniel
Geschrieben am: 27.09.2020 15:48:22

Hi

Naja, die Schaltflächen entstehen ja nicht von alleine.
Dazu braucht es ein .Add oder ein Copy-Paste.

Hast du deinen Code dahingehend schon durchsucht?
Ansonsten musst du den Code mal im Einzelstep durchsickern, dabei parallel schauen, was auf dem Blatt passiert und dann siehst du ja, wo die Schaltflächen dupliziert werden.

Denn Code in dem Bereich musst du dir genauer anschauen.

Da du uns nur einen Teil des Codes gezeigt hast, können wir dir so auch nicht viel weiterhelfen.
Wenn du die Stelle selbst nicht findest, solltest du die Datei mit vollständigem Code und anonymisierten Daten hochladen, sowie eine Beschreibung geben, was man tun muss damit sich die Schaltflächen verdoppeln.
Gruß Daniel

Betrifft: AW: Befehlsschaltflächen erstellen sich selb
von: Hartmut
Geschrieben am: 27.09.2020 16:23:15

Na, wenn das keine schnelle Hilfe war.
Auf den Einzelschritt bin ich einfach nicht gekommen.
Das hat schon geholfen und das Leben kann so einfach sein.. Ich hab den Fehler gefunden.
Warum ich das so gemacht hatte, weiß ich nicht, dass ist einfach zu lange her.
Wahrscheinlich hab ich ein vorhandenes Skript ohne genaue Prüfung übernommen.
Egal, ich freu mich - Der Fehler ist weg.

Danke!

Betrifft: AW: Befehlsschaltflächen erstellen sich selb
von: Herbert_Grom
Geschrieben am: 27.09.2020 17:00:26

Hallo Hartmut,

und welche diese Code-Zeilen war jetzt die Verursacherin?

Servus

Betrifft: AW: Befehlsschaltflächen erstellen sich selb
von: Hartmut
Geschrieben am: 27.09.2020 22:36:51

Moin,

der Befehl befand sich in einem Untermakro (Änderungsmeldung). Das hatte ich nicht ordentlich geprüft, eigentlich wohl eher gar nicht. Stattdessen hatte ich mir einen Workaround gebaut, indem ich am Ende ein Untermakro aufgerufen habe, dass die Schaltflächen löscht. Funktionierte aber nur, wenn keine weiteren Fehler auftraten. Damit konnte ich um, aber meine Mitarbeirinnen nicht. Nun denn,