Thema: Blatt in HTML exportieren wenn Checkbox aktiv ist

Servus, vielleicht kann mir hier einer weiterhelfen bei einem Dienstplan. In der Mappe gibt es für jeden Monat ein Blatt was immer nach dem Schema mm_jj aufgebaut ist, also für diesen Monat z.B. 04_24
für den Folgemonat, also 05_24 gibt es ebenfalls schon ein Blatt für die Vorplanung.

das Ganze wird beim Speichern als HTML exportiert um das auf einem Display anzeigen zu können. Das Makro dazu erstellt eine neue temporäre Mappe und kopiert sich bestimmte Bereiche der Mappe in die neue Temporäre Mappe mit einer bestimmten Formatierung - funktioniert auch alles wunderbar.

Jetzt möchte ich aber gerne, dass es die Monatsblätter erst anzeigt/exportiert, wenn eine entsprechende Checkbox (CheckBox1) aktiv ist die es auf jedem Monatsblatt gibt.
diese heißt eben auch immer CheckBox1 da immer das aktuelle Monatsblatt als Vorlage für den neuen Monat kopiert wird...Dabei soll es egal sein auf welchem Blat ich mich derzeit befinde beim Speichern (Activesheet geht damit schonmal nicht)

Ganz unten in den letzten paar Zeilen habe ich markiert, wo was angepasst werden muss, bestimmt mit if abfrage - aber wie am besten lösen?
das ist der Code:

Private Sub Workbook_BeforeSave(ByVal SaveAsUi As Boolean, Cancel As Boolean)



' Kopie des Dienstplans zur Anzeige 

   Druckbereich_Speichern



End Sub



Sub Druckbereich_Speichern()

    Dim wb As Workbook, ws As Worksheet, NewName As String, rBereich As String, WsName As String

    Dim nb As Workbook

    Dim fDisplayAlerts As Boolean

    

    fDisplayAlerts = Application.DisplayAlerts ' akt. Einstellung zu Meldungen merken und unten ...

    Application.DisplayAlerts = False

    

    Set wb = ActiveWorkbook

    WsName = ActiveSheet.Name

    

    NewName = "C:\Temp\DienstPlan.html"  ' so heißt die Datei zur Anzeige des Dienstplans auf Display

    Set nb = Application.Workbooks.Add  ' damit wird die neue (leere) Excel-Datei erzeugt und auch aktiv

    Application.ScreenUpdating = False

    

    For Each ws In wb.Worksheets

        ' gehe über alle Arbeitsblätter (Worksheets/TabSheets).

        ' Wenn der Name des Arbeitsblattes in der Liste steht (s.u.), dann wird es kopiert in die neue Arbeitsmappe.

        If InCopyList(ws.Name) Then  ' Wenn in der Liste der zu kopierenden Worksheets enthalten

            'ws.Activate

            rBereich = ws.PageSetup.PrintArea  ' ActiveSheet.PageSetup.PrintArea

            

            If rBereich <> "" Then  ' kopiere nur den eingestellten Druckbereich

                ws.Range(rBereich).Copy

                nb.Activate

                nb.ActiveSheet.Name = ws.Name

                Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats  'Werte und Zellformate einfügen

                Range("A1").PasteSpecial Paste:=xlPasteFormats                 'Formatierungen einfügen

                Range("A1").PasteSpecial Paste:=xlPasteColumnWidths            'Spaltenbreiten einfügen

                Range("A1").Select                                             'Select um Bereichsmarkierung aufzuheben

                Application.CutCopyMode = False

            Else

                Range("A1").Value = "Kein Druckbereich festgelegt."

            End If

            

            nb.Worksheets.Add After:=nb.Worksheets(nb.Worksheets.Count) ' ein neues TabSheet anfügen für den nächsten Durchlauf

            

        End If

    Next

   

    'nb.Worksheets(WsName).Activate

    nb.Worksheets(1).Activate  ' damit steht der Dienstplan immer auf dem aktuellen Monat

   

    ' Am Ende der Schleife füge pauschal ein Tabellen-Blatt ein. Das letzte (nicht benötigte) wird rausgeschmissen

    For Each ws In nb.Worksheets

        If Not InCopyList(ws.Name) Then

            nb.Worksheets(ws.Name).Delete

        End If

    Next

   

    ' Speichern im html-Format (macht sich besser mit dem SiteKiosk)

    'ActiveWorkbook.SaveAs Filename:=wb.Path & "\" & NewName & ".html", FileFormat:=xlHtml

    ActiveWorkbook.SaveAs NewName, FileFormat:=xlHtml

    ActiveWorkbook.Close

   

    wb.Activate

    Application.ScreenUpdating = True

    Application.DisplayAlerts = fDisplayAlerts ' ... wiederherstellen

End Sub

---



Function InCopyList(strIn As String) As Boolean

    Dim TabSheetList(4) As String

    TabSheetList(0) = Format(Now(), "mm_yy")   <--- Hier soll geprüft werden ob die Checkbox aktiv ist oder nicht

    TabSheetList(1) = Format(DateAdd("m", 1, Now()), "mm_yy") <--- und hier soll auch geprüft werden ob die Checkbox aktiv ist oder nicht

    TabSheetList(3) = Format("Plankürzel")

    TabSheetList(4) = Format("Jahresurlaub")

    TabSheetList(5) = Format("Feiertage") 'wird gebraucht um Feiertage auch in der neuen Temporären Arbeitsmappe mittels sverweis anzuzeigen

    InCopyList = Not (IsError(Application.Match(strIn, TabSheetList, 0)))

End Function

Hallöchen,
wenn Du eine Checkbox aus den Formularsteuerelementen nimmst, kannst Du diese mit einer Zelle verknüpfen und den Zelleintrag nutzen, im Prinzip

If Sheets(strIn).Range("A1") = true then 

'...

End If

Man kann doch auch ActiveX Steuerelemente mit Zellen verknüpfen, geht das da nicht auch (zumindest steht dann in der Zelle auch Wahr/Falsch drin)
Aber würde er das da nicht auf alle Monatsblätter anwenden wenn in einem Monatsblatt in A1 wahr drin steht?
Mir gehts wie gesagt darum, dass wenn ich die Checkbox im Blatt 04_24 aktiv habe und im 05_24 noch nicht aktiv habe, dann soll er beim Exportieren der Blätter in die temporäre Arbeitsmappe auch nur den Monat 04_24 anzeigen, nicht aber den 05_24.
erst wen da die Checkbox aktiv ist, soll er das mit exportieren.

Hallöchen,

1) jupp, klar, geht auch. Die anderen sind zuweilen für den einen oder anderen einfacher :-)
2) du wolltest das in Deiner Funktion. Der übergibst Du den jeweiligen Blattname und dort prüfe ich blattbezogen Sheets(strIn).Range("A1")

wo muss dass dann aber eingefügt werden?

so hier gehts jedenfalls nicht:

Function InCopyList(strIn As String) As Boolean

    Dim TabSheetList(4) As String

    If Sheets(strIn).Range("AX1") = True Then

        TabSheetList(0) = Format(Now(), "mm_yy")

    End If

    If Sheets(strIn).Range("AX1") = True Then

        TabSheetList(1) = Format(DateAdd("m", 1, Now()), "mm_yy")

    End If

    TabSheetList(2) = Format("Plankürzel")

    TabSheetList(3) = Format("Jahresurlaub")

    TabSheetList(4) = Format("Feiertage")

    InCopyList = Not (IsError(Application.Match(strIn, TabSheetList, 0)))

End Function

es gibt ja noch andere Blätter innerhalb der Mappe, wo es kein Checkbox feld gibt. Das gibts nur in den Monats-Blättern

Hallöchen,
Dann musst Du beides prüfen. Bin gerade nur am Handy, im Prinzip
If (Monatsblatt and true) or (kein Monatsblatt) Then...
Wobei Du auch alles was da betroffen ist reinschreiben kannst und nicht für jede Code zeile die Prüfung wiederholen musst.

Wie Du auf Monatsblatt prüfen kannst hängt vom Blattnamen ab. Vielleicht geht was in Richtung istzahl, vieleicht über den Monatsnamen oder das Kürzel...

bekomme das leider nicht hin :-/

Hallöchen,

wenn die beiden Zeilen nur auf den Monatsblättern mit X wirken sollen, dann

'Wenn die ersten beiden Zeichen des Blattnamen numerisch sind und dort in AX1 Wahr steht, dann 

If IsNumeric(Left(strIn, 2)) And Sheets(strIn).Range("AX1") = True Then

  TabSheetList(0) = Format(Now(), "mm_yy")

  TabSheetList(1) = Format(DateAdd("m", 1, Now()), "mm_yy")

End If

Sollen die auf den Monatsblättern mit X und allen anderen wirken, dann müsste die Prüfung so aussehen:
If (IsNumeric(Left(strIn, 2)) And Sheets(strIn).Range("AX1") = True) Or Not IsNumeric(Left(strIn, 2)) Then

Guten Morgen. Ich danke dir vielmals für deine Unterstützung und Hilfe :)
leider funktioniert es nicht so wie es wohl sollte :-/

Hab mal eine DummyDatei gebaut und hier angefügt:
https://www.herber.de/bbs/user/168793.xlsm

um die HTML datei zu erzeugen beim speichern, muss im VBA editor bei "DieseArbeitsmappe" oben die Aus-Kommentierung bei Druckbereich_Speichern raus genommen werden, dann erstellt er die HTML unter C:\temp\DummyDienstPlan.html

Und in jedem Monatsblatt gibt es eine Checkbox, welche ich jetzt schon mit AX1 verknüpft habe. Da ist auch die frage ob man das so wirklich braucht, oder ob man nicht gleich den Status der Checkbox abfragen kann (Checkbox1.value = true )

klar, das Skript nimmt sich so wie es jetzt ist eh nur den Aktuellen Monat, und den Folgemonat für die HTML Erzeugung, aber kann gut sein, dass auch mal der 2. Folgemonat mit rein genommen wird im Skript. Und da soll eben über die Checkbox definiert werden, ob es dieses Blatt mit in die HTML aufnehmen soll oder nicht

Hallöchen,

erst mal zwei Hinweise
1)
zum löschen des letzten Blattes im neuen wb nimm bitte

    ' Am Ende der Schleife: füge ein Tabellen-Blatt ein. Das letzte (nicht benötigte) wird wieder gelöscht.

    nb.Sheets(nb.Sheets.Count).Delete

    'For Each ws In nb.Worksheets

    '    If Not InCopyList(ws.Name) Then

    '        nb.Worksheets(ws.Name).Delete

    '    End If

    'Next

Dann kannst Du Dir die Schleife sparen

2)
reduziere die Function auf die anderen, nichtmonats - Blätter.

Function InCopyList(strIn As String) As Boolean

    Dim TabSheetList(4) As String

    TabSheetList(0) = "einBlatt"

    TabSheetList(1) = "nocheinBlatt"

    TabSheetList(2) = "Jahresurlaub"

    TabSheetList(3) = "Feiertage"

    InCopyList = Not (IsError(Application.Match(strIn, TabSheetList, 0)))

End Function

Für die erforderlichen Monatsblätter wertest Du lediglich AX1 aus:

        ' gehe über alle Arbeitsblätter (Worksheets/TabSheets).

        ' Wenn der Name des Arbeitsblattes in der Liste steht (s.u.), dann wird es kopiert in die neue Arbeitsmappe.

        If InCopyList(ws.Name) Or ws.Range("AX1") = True Then  ' Wenn in der Liste der zu kopierenden Worksheets enthalten