Also die Beispiel-Datei besteht aus Folgendem:
4 Blätter mit irgendwelchem Inhalt (nur nicht leer)
Namen:
Tab 0001
Tab 0002
Tab 0003
Tab 0004
1 Blatt
Name: Master
mit 4 Checkboxen
Eigenschaften->Caption jeweils einen Tabellenblattnamen Tab 0001, Tab 0002, Tab 0003, Tab 0004
mit 5 Option-Button
a) Eigenschaften:
Eigenschaften->Name : OB_nichtsmachen
Eigenschaften->Caption : nichts machen
Eigenschaften->GroupName: MasterOB
b)
Eigenschaften->Name : OB_ausblenden
Eigenschaften->Caption : ausblenden
Eigenschaften->GroupName: MasterOB
c)
Eigenschaften->Name : OB_allesEinblenden
Eigenschaften->Caption : alles einblenden
Eigenschaften->GroupName: MasterOB
d)
Eigenschaften->Name : OB_DruckVorschau
Eigenschaften->Caption : Druck-Vorschau
Eigenschaften->GroupName: MasterOB
e)
Eigenschaften->Name : OB_Druck
Eigenschaften->Caption : drucken
Eigenschaften->GroupName: MasterOB
GroupName wird hier bei den Option-Button gesetzt, um zu erreichen, dass automatisch immer nur einer ausgewählt ist.
In die Code-Seite des Master-Blattes muß dann folgender Code eingesetzt werden:
Code:
Option Explicit
'************************************************************************************************
Private Function TestChkBox(wsm As Worksheet, fBlattname() As String, fValue() As Boolean, fCnt As Long)
'*** Makro sucht auf dem Arbeitsblatt alle Checkboxen
'*** Caption der jeweiligen Checkbox wird geprüft, ob es einem Blattnamen entspricht
'*** Wenn nein, erfolgt eine Meldung
'*** Caption(also Blattname) und Value werden in Feldern gespeichert und zurückgegeben.
Dim wsx As Worksheet, o As Object
Dim sCaption As String
ReDim fBlattname(1 To 1): ReDim fValue(1 To 1): fCnt = 0
For Each o In wsm.OLEObjects
If o.progID = Forms.CheckBox.1 Then
sCaption = o.Object.Caption
Set wsx = Nothing
On Error Resume Next
Set wsx = wsm.Parent.Worksheets(sCaption)
On Error GoTo 0
If wsx Is Nothing Then
MsgBox _
Caption in Checkbox enthält kein Blattnamen ! & vbLf & vbLf & _
Datei-Name:-> & wsm.Parent.Name &-> & vbLf & _
Blatt-Name:-> & wsm.Name &-> & vbLf & _
CheckBox-Name:-> & o.Name &-> & vbLf & _
Caption:-> & sCaption &->
Else
If wsx.Name = wsm.Name Then
MsgBox
Else
fCnt = fCnt + 1
ReDim Preserve fBlattname(1 To fCnt)
ReDim Preserve fValue(1 To fCnt)
fBlattname(fCnt) = sCaption
fValue(fCnt) = o.Object.Value
End If
End If
End If
Next
Set wsx = Nothing: Set o = Nothing
End Function
'*************************************************
Private Function MeinDrucken(bDrucken As Boolean)
Dim fBlattname() As String, fValue() As Boolean, fCnt As Long
Dim x As Long, bSichtbarGemacht As Boolean
Call TestChkBox(Me, fBlattname(), fValue(), fCnt)
If fCnt > 0 Then
For x = 1 To fCnt
If fValue(x) Then
If Me.Parent.Worksheets(fBlattname(x)).Visible <> xlSheetVisible Then
bSichtbarGemacht = True
Me.Parent.Worksheets(fBlattname(x)).Visible = True
Else
bSichtbarGemacht = False
End If
If bDrucken Then
Me.Parent.Worksheets(fBlattname(x)).Print
Else
Me.Parent.Worksheets(fBlattname(x)).PrintPreview
End If
If bSichtbarGemacht Then
Me.Parent.Worksheets(fBlattname(x)).Visible = False
End If
End If
Next
End If
End Function
'*************************************************
Private Sub OB_allesEinblenden_Click()
Dim fBlattname() As String, fValue() As Boolean, fCnt As Long, x As Long
Call TestChkBox(Me, fBlattname(), fValue(), fCnt)
If fCnt > 0 Then
Application.ScreenUpdating = False
For x = 1 To fCnt
Me.Parent.Worksheets(fBlattname(x)).Visible = True
Next
Application.ScreenUpdating = True
End If
Me.OB_nichtsmachen.Value = True
End Sub
'*************************************************
Private Sub OB_ausblenden_Click()
Dim fBlattname() As String, fValue() As Boolean, fCnt As Long, x As Long
Call TestChkBox(Me, fBlattname(), fValue(), fCnt)
If fCnt > 0 Then
Application.ScreenUpdating = False
For x = 1 To fCnt
If fValue(x) Then
Me.Parent.Worksheets(fBlattname(x)).Visible = False
End If
Next
Application.ScreenUpdating = True
End If
Me.OB_nichtsmachen.Value = True
End Sub
'*************************************************
Private Sub OB_Druck_Click()
Call MeinDrucken(True)
Me.OB_nichtsmachen.Value = True
End Sub
'*************************************************
Private Sub OB_DruckVorschau_Click()
Call MeinDrucken(False)
Me.OB_nichtsmachen.Value = True
End Sub
'*************************************************
Private Sub Worksheet_Activate()
Me.OB_nichtsmachen.Value = True
End Sub
Gruß Matjes
