Zeilen und Tabellenblätter per VBA ausblenden
04.04.2017 07:25:43
Gecko
ich habe auf dem ersten Reiter ein Feld (I5) mit Auswahl der Monate Januar bis Dezember und ein Button, der das Makro ausführt.
Nach dem Ausführen soll nun auf den Reitern 5 bis Ende geschaut werden, ob in den Zellen (T11:T375) mit einem X belegt sind (sind die Tage im ausgewählten Monat), diese sollen dann eingeblendet bleieben, der Rest soll ausgeblendet werden. Danach wird in "U2" geschaut, ob das Blatt ausgewählt werden soll, die anderen Reiter werden ausgeblendet. Beide Schritte werden in einem "Druckenmakro" einbetettet.
Hier einmal den Teil des Makro mit dem die Reiter ausgewählt werden:
For i = 5 To Sheets.Count
If Sheets(i).Range("U2") = "NEIN" Then
sichtbar = False
Else
sichtbar = True
zuDrucken = zuDrucken & Sheets(i).Name & "?"
End If
If sichtbar Sheets(i).Visible Then Sheets(i).Visible = sichtbar
Next
Da das Makro immer wieder angewendet wird, muss natürlich zuerst alles eingeblendet werden, danach das ausblenden, der nicht benötigten Zeilen.
In A11:A375 stehen die Daten 01.01.2017 bis 31.12.2017 und in T11:T375 wird mit "X" ausgegeben, ob der Tag in den Monat fällt, der auf dem ersten Reiter ausgewählt wurde.
Hier das komplette Makro, falls jemand die Gesamtübersicht haben will, aber nur der wichtige Teil, ohne FEHLER:
Sub Drucken()
Dim i As Long
Dim sichtbar As Boolean
Dim zuDrucken As String
Dim arrDrucken As Variant
Dim p1 As String
Dim p2 As String
Dim p3 As String
Dim p4 As String
Dim zeile As Long
Dim wks As Worksheet
Application.ScreenUpdating = False
p2 = Sheets(1).Cells(50, 2)
p3 = Sheets(1).Cells(50, 3)
p4 = Sheets(1).Cells(50, 4)
p1 = InputBox("Bitte Passwort eingeben!", "Passworteingabe")
If p1 = "" Then
MsgBox "Kein Passwort eingegeben!" & vbLf & vbLf & "Blattschutz wird nicht nicht _
aufgehoben!"
Exit Sub
End If
On Error GoTo FEHLER
If p1 = Sheets(1).Cells(48, 2) Or p1 = Sheets(1).Cells(48, 3) Or p1 = Sheets(1).Cells(48, 4) _
Then
For i = 5 To Sheets.Count
If Sheets(i).Range("U2") = "NEIN" Then
sichtbar = False
Else
sichtbar = True
zuDrucken = zuDrucken & Sheets(i).Name & "?"
End If
If sichtbar Sheets(i).Visible Then Sheets(i).Visible = sichtbar
Next
zuDrucken = Left(zuDrucken, Len(zuDrucken) - 1) ' letztes "?" weg
arrDrucken = Split(zuDrucken, "?") ' in ein "Array" überführen
If UBound(arrDrucken) Gecko