Microsoft Excel

Herbers Excel/VBA-Archiv

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

Tabellenblätter gem. Checkbox Auswahl exportieren


Betrifft: Tabellenblätter gem. Checkbox Auswahl exportieren von: Joel
Geschrieben am: 22.09.2017 17:45:25

Ich habe eine Datei mit mehreren Tabellenblätter. 4 davon liefern mir Resultate welche ich je nach Bedarf durch die Auswahl der 4 Checkboxen in eine separate Datei exportieren kann. Das ist mir mit folgendem Code gelungen:

= Dim bReportDelta As Boolean: bReportDelta = Worksheets(constWorksheetNameSteuerung) .Shapes(constCheckBoxReportDelta).OLEFormat.Object.Value > = 0
Dim bReportRating As Boolean: bReportRating = Worksheets(constWorksheetNameSteuerung).Shapes(constCheckBoxReportRating).OLEFormat.Object.Value >= 0
Dim bReportInventar As Boolean: bReportInventar = Worksheets(constWorksheetNameSteuerung).Shapes(constCheckBoxReportInventar).OLEFormat.Object.Value >= 0
Dim bReportEvolan As Boolean: bReportEvolan = Worksheets(constWorksheetNameSteuerung).Shapes(constCheckBoxReportEvolan).OLEFormat.Object.Value >= 0
Dim i As Integer, Sh As Integer

If bReportDelta Then
If bReportRating Then
If bReportInventar Then
If bReportEvolan Then
Sheets(Array("Bilanz_ER", "Auswertung_Rating", "Auswertung_Inventar", "Auswertung_Evolan")).Copy
Else
Sheets(Array("Bilanz_ER", "Auswertung_Rating", "Auswertung_Inventar")).Copy
End If
ElseIf bReportEvolan Then
Sheets(Array("Bilanz_ER", "Auswertung_Rating", "Auswertung_Evolan")).Copy
Else
Sheets(Array("Bilanz_ER", "Auswertung_Rating")).Copy
End If
ElseIf bReportInventar Then
If bReportEvolan Then
Sheets(Array("Bilanz_ER", "Auswertung_Inventar", "Auswertung_Evolan")).Copy
Else
Sheets(Array("Bilanz_ER", "Auswertung_Inventar")).Copy
End If
ElseIf bReportEvolan Then
Sheets(Array("Bilanz_ER", "Auswertung_Evolan")).Copy
Else
Sheets(Array("Bilanz_ER")).Copy
End If
ElseIf bReportRating Then
If bReportInventar Then
If bReportEvolan Then
Sheets(Array("Auswertung_Rating", "Auswertung_Inventar", "Auswertung_Evolan")).Copy
Else
Sheets(Array("Auswertung_Rating", "Auswertung_Inventar")).Copy
End If
ElseIf bReportEvolan Then
Sheets(Array("Auswertung_Rating", "Auswertung_Evolan")).Copy
Else
Sheets(Array("Auswertung_Rating")).Copy
End If
ElseIf bReportInventar Then
If bReportEvolan Then
Sheets(Array("Auswertung_Inventar", "Auswertung_Evolan")).Copy
Else
Sheets(Array("Auswertung_Inventar")).Copy
End If
ElseIf bReportEvolan Then
Sheets(Array("Auswertung_Evolan")).Copy
End If

Nun suche ich nach einer Vereinfachung, damit allenfalls auch eine 5 Auswahlmöglichkeit eingefügt werden kann ohne x-Zeilen neuen Code zu schreiben. Gibt es Variante mit einer Schlaufe?

  

Betrifft: AW: Tabellenblätter gem. Checkbox Auswahl exportieren von: Sepp
Geschrieben am: 22.09.2017 20:32:50

Hallo Joel,

für eine Schleife, solltest du die Checkboxen mt einem Index versehen, aufbauend auf deinem Beispiel kannst du es so lösen.

Ungetestet!

Sub halloween()
Dim varSheets() As Variant, lngIndex As Long


With Worksheets(constWorksheetNameSteuerung)
  If .Shapes(constCheckBoxReportDelta).OLEFormat.Object.Value >= 0 Then Redim _
    varSheets(lngIndex): varSheets(lngIndex) = "Bilanz_ER": lngIndex = lngIndex + 1
  If .Shapes(constCheckBoxReportRating).OLEFormat.Object.Value >= 0 Then Redim Preserve _
    varSheets(lngIndex): varSheets(lngIndex) = "Auswertung_Rating": lngIndex = lngIndex + 1
  If .Shapes(constCheckBoxReportInventar).OLEFormat.Object.Value >= 0 Then Redim Preserve _
    varSheets(lngIndex): varSheets(lngIndex) = "Auswertung_Inventar": lngIndex = lngIndex + _
    1
  If .Shapes(constCheckBoxReportEvolan).OLEFormat.Object.Value >= 0 Then Redim Preserve _
    varSheets(lngIndex): varSheets(lngIndex) = "Auswertung_Evolan": lngIndex = lngIndex + 1
End With

If lngIndex > 0 Then Sheets(varSheets).Copy

End Sub


Gruß Sepp



  

Betrifft: AW: Tabellenblätter gem. Checkbox exportieren von: Joel
Geschrieben am: 25.09.2017 14:34:07

Hallo Sepp

Vielen Dank für die Vereinfachung, das hilft mir sehr viel weiter nachdem ich schon mehrere Stunden vergebens herumgebastelt habe. Es funktioniert einwandfrei!

Danke und Gruss


Beiträge aus den Excel-Beispielen zum Thema "Tabellenblätter gem. Checkbox Auswahl exportieren"