VBA Ein- und Ausblenden von Zeilen
Mike
Guten Morgen an die Experten.
Seit mehreren Tagen beschäftigt mich folgendes Problem und ich hoffe hier eine Lösung zu finden.
Ich habe eine .xlsm Datei mit mehreren Tabellenblättern. Unter anderem mit dem Namen "Personal" und "Transportbericht".
Vielen Danke!!
Im Blatt Transportbericht ist eine Formel in der Zelle "AB5" die ihr Ergebnis anhand einer Verweis-Formel ins Blatt "Personal" ändert. In 1 oder 0. (Es wird anhand eines Dropdownfeldes im Blatt "Personal" ein Name ausgewählt = 1 oder es bleibt leer = 0)
Nun möchte ich ein Makro, dass im Blatt "Transportbericht", die Zeilen 15 und 22 bis 28 automatisch einblenden wenn das Ergebnis der oben genannten Formel in "AB5", 1 ist und ausblenden wenn das Ergebnis 0 ist. Das Ein- und Ausblenden soll automatisch passieren wenn ein Name im Blatt "Personal" geändert wird und sich der Wert der Formel im Blatt "Transportbericht" ändert, ohne die Zelle in der die Formel steht, vorher zu bestätigen.
Einen Code habe ich bereits, allerdings bekomme ich jedesmal einen Fehler bei "singleArea.Hidden=true"
Private Old_AB5_Value As String ' steht ganz oben im Arbeitsblattmodul
Private Sub Worksheet_Calculate()
Dim ws As Worksheet
Dim bedingungsZelle As Range
Dim zeilenZumUmschalten As Range
Dim aktuellerBedingungsWert As String
Dim tmpValue As Variant
Dim singleArea As Range
Set ws = Me
Set bedingungsZelle = ws.Range("AB5")
Set zeilenZumUmschalten = Union(ws.Rows(15), ws.Rows("22:28"))
tmpValue = bedingungsZelle.Value
If IsError(tmpValue) Then
aktuellerBedingungsWert = "FEHLER"
Else
aktuellerBedingungsWert = CStr(tmpValue)
End If
If aktuellerBedingungsWert <> Old_AB5_Value Then
Old_AB5_Value = aktuellerBedingungsWert
On Error Resume Next
ws.Unprotect "Passwort"
On Error GoTo 0
If aktuellerBedingungsWert = "1" Then
For Each singleArea In zeilenZumUmschalten.Areas
singleArea.Hidden = False ' Hier wird der Fehler ausgelöst
Next singleArea
Else
For Each singleArea In zeilenZumUmschalten.Areas
singleArea.Hidden = True
Next singleArea
End If
On Error Resume Next
ws.Protect "Passwort"
UserInterfaceOnly:=True
On Error GoTo 0
End If
End Sub
' steht im "ThisWorkbook"-Modul
Private Sub Workbook_Open()
On Error Resume Next
Old_AB5_Value = ThisWorkbook.Sheets("Transportbericht").Range("AB5").Value
If IsError(Old_AB5_Value) Then Old_AB5_Value = "0"
On Error GoTo 0
End Sub