763 Aufrufe
Gefragt in Tabellenkalkulation von ekg Mitglied (303 Punkte)
Hallo zusammen,

ich such einen VBA Cocde mit dem ich in Excel in einer Mappe mehrere
Blätter auf einmal ein bzw. ausblenden kann.

Ich habe eine Mappe in der 15 Arbeitsblätter sind die die Namen KW 01, KW
02; KW 03 usw. haben.

Wie kann ich alle Blätter außer das mit dem Namen KW 02 oder beim
nächsten mal das KW 03 ausblenden und danach alle wieder einblenden.

De Clou wäre wenn ich aus dem ersten Blatt das Cockpit heißt eine
Auswahl hätte die dem Code sagt welches Blatt nicht ausgeblendet werden
soll z.B. ein Auswafeld.

Gruß Erwin

8 Antworten

0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi Erwin ^^

z.b.

die arbeitsblaetter werden anhand einer auswahlliste ausgeblendet
und durch Wechselwirkung wieder eingeblendet

A1 rechtsclick Auswahlliste

als naechstes

einzufuegen alt+f11>allgemeines modul

einmalig starten zum einlesen der auswahlliste

Sub Liste_Einlesen()
With Worksheets("Cockpit").Range("A1").Validation
.Delete
For WksNamen = 1 To Worksheets.Count
If WksNamen < Worksheets.Count Then
NamenSammeln = NamenSammeln & Worksheets(WksNamen).Name & ","
Else
NamenSammeln = NamenSammeln & Worksheets(WksNamen).Name
End If
Next WksNamen
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=NamenSammeln
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End Sub


einzufuegen alt+f11>projektexplorer>Cockpit

$A$1 ist die Auswahlliste

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = "$A$1" Then Call EinAusblendung
Application.EnableEvents = True
End Sub


einzufuegen alt+f11>allgemeines modul

das modul arbeitet in Wechselwirkung
weise dem makro eine taste zu oder gib jedem blatt einen button der das makro startet
nun hast du die Möglichkeit von jedem beliebigen blatt aus wieder alle blätter einzublenden

Sub EinAusblendung()
If Worksheets("Cockpit").Visible = True Then schalter = True
For WksNamen = 1 To Worksheets.Count
If Worksheets("Cockpit").Cells(1, 1) <> Worksheets(WksNamen).Name And schalter = True Then
Worksheets(WksNamen).Visible = False
End If
If schalter = False Then
Worksheets(WksNamen).Visible = True
Worksheets("Cockpit").Activate
End If
Next WksNamen
End Sub


gruss nighty
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi all ^^

sollte beim anpassen eventuell fehler entstehen
könnte es sein das das ereigniss nicht wieder eingeschaltet wurde

dann das folgende makro starten zum wieder einschalten des ereignisses

Sub EreEinschalten()
Application.EnableEvents = True
End Sub


gruss nighty
0 Punkte
Beantwortet von ekg Mitglied (303 Punkte)
Hallo nighty,

danke erstmal. Sieht gut aus.
Werde es morgen testen und mich dann nochmal melden

Gruß Erwin.
0 Punkte
Beantwortet von ekg Mitglied (303 Punkte)
Hallo Nighty,

kann ich das Blatt Cockpit aus der Auswahl zum ausblenden ausschließen?

Gruß Erwin
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi Erwin ^^

vielleicht so ?

gruss nighty

Sub Liste_Einlesen()
With Worksheets("Cockpit").Range("A1").Validation
.Delete
For WksNamen = 1 To Worksheets.Count
If Worksheets(WksNamen).Name <> "Cockpit" Then
If WksNamen < Worksheets.Count Then
NamenSammeln = NamenSammeln & Worksheets(WksNamen).Name & ","
Else
NamenSammeln = NamenSammeln & Worksheets(WksNamen).Name
End If
End If
Next WksNamen
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=NamenSammeln
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End Sub
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi Erwin und all ^^

im Normalfall haette es gereicht aus obigen makro die 1 (For Next Schleife)durch eine 2 zu ersetzen
da aber die Erstellung der worksheets nicht bekannt ist habe ich eine weitere if abfrage erstellt

gruss nighty
0 Punkte
Beantwortet von ekg Mitglied (303 Punkte)
Hallo Nighty,

das mit der 2 funktioniert einwandfrei.

Vielen Vielen dank für die gute und schnelle Hilfe.

Gruß Erwin
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi Erwin ^^

*Die besten Antworten in dieser Stadt zu dieser Zeit im Supportnet*

gruss nighty
...