Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1316to1320
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Drop Down - Arbeitsblaetter auswaehlen

Drop Down - Arbeitsblaetter auswaehlen
21.06.2013 13:04:49
Martin
hallo!
ich bitte wieder um hilfe. ich habe im internet einen fuer mich super brauchbaren code gefunden, der mir als drop down alle arbeitsblaetter des workbooks anzeigt. nun wuerde ich gerne in dem code einen filter haben, dass nur arbeitsblaetter, die mit dem namen "Sector ID" beginnen, angezeigt werden. nach dem namen sector id kommt nur mehr eine zahl.
ich habe den code unten angefuegt.
vielen dank im voraus fuer eure muehen!
liebe gruesse,
martin

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Call menu_tabellen
End Sub
Private Sub Workbook_Open()
Call menu_tabellen
End Sub
Public Sub menu_tabellen()
Dim sheet As Worksheet
With Application.CommandBars(1)
On Error Resume Next
.Controls("&Tabellen").Delete
On Error GoTo 0
With .Controls.Add( _
Type:=msoControlPopup, _
before:=.Controls("&?").Index, _
temporary:=True)
.Caption = "&Print Sector ID"
For Each sheet In Sheets
With .Controls.Add(Type:=msoControlButton)
.Caption = sheet.Name
.Style = msoButtonCaption
.OnAction = "'tabelle_einblenden (""" & sheet.Name & """)'"
.State = msoButtonUp
End With
Next sheet
End With
End With
End Sub
Public Sub tabelle_einblenden(auswahl As String)
Dim sheet As Worksheet
Sheets(auswahl).Visible = xlSheetVisible
For Each sheet In Sheets
If sheet.Name  auswahl Then sheet.Visible = xlSheetHidden
Next sheet
End Sub
/pre>

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Nur bestimmte Tabellenblätter auflisten
21.06.2013 15:17:38
NoNet
Hallo Martin,
das lässt sich mit einer kleinen Ergänzung realisieren (siehe fett gedruckte Zeilen). Allerdings sollte man bzgl. der Ribbons unter Excel2007/2010 auch die CommandBars anders befüllen bzw. löschen : Sie werden in der Gruppe "Menübefehle" eingefügt und daher bei erneuter Ausführung auch nicht gelöscht. Daher habe ich das Control hier im Code mit einem TAG versehen ("PrintSectorID") um es darüber zu identifizieren und gezielt zu löschen :
Public Sub menu_tabellen()
Dim sheet As Worksheet
With Application.CommandBars(1)
On Error Resume Next
.FindControl(Tag:="PrintSectorID").Delete
On Error GoTo 0
With .Controls.Add( _
Type:=msoControlPopup, _
before:=.Controls("&?").Index, _
temporary:=True)
.Caption = "&Print Sector ID"
.Tag = "PrintSectorID"
For Each sheet In Sheets
 If UCase(sheet.Name) Like "SECTOR ID*" Then
With .Controls.Add(Type:=msoControlButton)
.Caption = sheet.Name
.Style = msoButtonCaption
.OnAction = "'tabelle_einblenden (""" & sheet.Name & """)'"
.State = msoButtonUp
End With
End If
Next sheet
End With
End With
End Sub
Gruß, NoNet

Anzeige
AW: Nur bestimmte Tabellenblätter auflisten
21.06.2013 15:26:58
Martin
hallo NoNet!
vielen dank fuer die rasche hilfe! das ist unglaublich, wie einfach das funktioniert, wenn man sich auskennt!
herzliche gruesse,
martin

AW: Nur bestimmte Tabellenblätter auflisten
21.06.2013 17:54:56
Martin
hallo NoNet!
ich habe nun versucht, den code fuer mich noch anzupassen. dabei bin ich auf ein problem gestossen, dass er mich nicht in mein sub zum ausdrucken springen laesst. ich habe unten nochmals die relevanten teile angehangt. kannst du mir bitte dabei nochmals behilflich sein?
danke im voraus,
lg
martin

Sub SectorDropdown()
Dim sheet As Worksheet
With Application.CommandBars(1)
On Error Resume Next
.FindControl(Tag:="PrintSectorID").Delete
On Error GoTo 0
With .Controls.Add( _
Type:=msoControlPopup, _
before:=.Controls("&?").Index, _
temporary:=True)
.Caption = "&Print Sector ID"
.Tag = "PrintSectorID"
For Each sheet In Sheets
If UCase(sheet.Name) Like "SECTOR ID*" Then
With .Controls.Add(Type:=msoControlButton)
.Caption = sheet.Name
.Style = msoButtonCaption
.OnAction = "'DruckenSectorID (""" & sheet.Name & """)'"
.State = msoButtonUp
End With
End If
Next sheet
End With
End With
End Sub
Sub DruckenSectorID (""" & sheet.Name & """)
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Sheets(""" & sheet.Name & """).Activate
Dim AnzahlEinträgeZeilen As Integer
Dim AnzahlEinträgeSpalten As Integer
AnzahlEinträgeZeilen = WorksheetFunction.CountA(Sheets("" & sheet.Name & """).Range("A:A"))
AnzahlEinträgeSpalten = WorksheetFunction.CountA(Sheets("" & sheet.Name & """).Range("1:1")) _
' ActiveSheet.Cells.EntireColumn.HorizontalAlignment = xlCenter
Rows("1:1").EntireRow.HorizontalAlignment = xlCenter
ActiveSheet.PageSetup.PrintArea = _
Range(Cells(1, 1), Cells(AnzahlEinträgeZeilen, AnzahlEinträgeSpalten)).Address
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
End With
'Strichlierungen einfügen
Cells.EntireColumn.Borders(xlEdgeTop).LineStyle = xlDot
Cells.EntireColumn.Borders(xlEdgeRight).LineStyle = xlDot
Cells.EntireColumn.Borders(xlEdgeLeft).LineStyle = xlDot
Cells.EntireColumn.Borders(xlInsideVertical).LineStyle = xlDot
Cells.EntireColumn.Borders(xlInsideHorizontal).LineStyle = xlDot
Rows("1:1").Borders(xlEdgeBottom).LineStyle = xlDouble
ActiveSheet.PageSetup.PrintArea = _
Range(Cells(1, 1), Cells(AnzahlEinträgeZeilen, AnzahlEinträgeSpalten)).Address
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.CenterHeader = "Amiri Flight - SPOC Sector ID Sheet - TOP SECRET"
.LeftFooter = "&""-,Fett""&8 &A" & Chr(10) & "Amiri Flight"
'CenterFooter = "Printed by:  " & Environ("username")  'Das waere mit Username Zusatz,  _
so wie der User am Computer angemeldet ist
.CenterFooter = "TOP SECRET!"
.RightFooter = "&8&D  -  &t" & Chr(10) & "Page &P of &N"
.PrintErrors = xlPrintErrorsDisplayed
End With
Application.ScreenUpdating = True
'Dim a As String
'a = MsgBox("This is a very big file! Are you sure you want to print this file?", vbYesNo, " _
CHECK IF YOU NEED TO PRINT THIS FILE")
'If a = vbNo Then
'   GoTo keindruck
'End If
Application.Dialogs(xlDialogPrint).Show
keindruck:
Rows("1:1").EntireRow.HorizontalAlignment = xlLeft
'Strichlierungen entfernen
Rows("1:1").Borders(xlEdgeBottom).LineStyle = xlNone
Cells.EntireColumn.Borders(xlEdgeTop).LineStyle = xlNone
Cells.EntireColumn.Borders(xlInsideVertical).LineStyle = xlNone
Cells.EntireColumn.Borders(xlInsideHorizontal).LineStyle = xlNone
Cells.EntireColumn.Borders(xlEdgeRight).LineStyle = xlNone
Cells.EntireColumn.Borders(xlEdgeLeft).LineStyle = xlNone
ErrorHandler:
On Error GoTo 0
End Sub

Anzeige
AW: Nur bestimmte Tabellenblätter auflisten
22.06.2013 09:34:52
fcs
Hallo Martin,
du musst in der Sub-Deklaration eine Variable für den als Parameter zu verwendenden Blattnamen definieren. Analog der im anderen Makro zur Anzeige der Blätter.
Diese Variable mit dem Blattnamen kannst du dann in der Sub verwenden.
Gruß
Franz
Sub DruckenSectorID(strSheetName as String)
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Sheets(strSheetName).Activate
Dim AnzahlEinträgeZeilen As Integer
Dim AnzahlEinträgeSpalten As Integer
AnzahlEinträgeZeilen = WorksheetFunction.CountA(Sheets(strSheetName).Range("A:A"))
AnzahlEinträgeSpalten = WorksheetFunction.CountA(Sheets(strSheetName).Range("1:1"))
' ActiveSheet.Cells.EntireColumn.HorizontalAlignment = xlCenter
Rows("1:1").EntireRow.HorizontalAlignment = xlCenter
ActiveSheet.PageSetup.PrintArea = _
Range(Cells(1, 1), Cells(AnzahlEinträgeZeilen, AnzahlEinträgeSpalten)).Address
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
End With
'Strichlierungen einfügen
Cells.EntireColumn.Borders(xlEdgeTop).LineStyle = xlDot
Cells.EntireColumn.Borders(xlEdgeRight).LineStyle = xlDot
Cells.EntireColumn.Borders(xlEdgeLeft).LineStyle = xlDot
Cells.EntireColumn.Borders(xlInsideVertical).LineStyle = xlDot
Cells.EntireColumn.Borders(xlInsideHorizontal).LineStyle = xlDot
Rows("1:1").Borders(xlEdgeBottom).LineStyle = xlDouble
ActiveSheet.PageSetup.PrintArea = _
Range(Cells(1, 1), Cells(AnzahlEinträgeZeilen, AnzahlEinträgeSpalten)).Address
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.CenterHeader = "Amiri Flight - SPOC Sector ID Sheet - TOP SECRET"
.LeftFooter = "&""-,Fett""&8 &A" & Chr(10) & "Amiri Flight"
'CenterFooter = "Printed by:  " & Environ("username")  'Das waere mit Username Zusatz, _
so wie der User am Computer angemeldet ist
.CenterFooter = "TOP SECRET!"
.RightFooter = "&8&D  -  &t" & Chr(10) & "Page &P of &N"
.PrintErrors = xlPrintErrorsDisplayed
End With
Application.ScreenUpdating = True
'Dim a As String
'a = MsgBox("This is a very big file! Are you sure you want to print this file?", vbYesNo, "  _
_
CHECK IF YOU NEED TO PRINT THIS FILE")
'If a = vbNo Then
'   GoTo keindruck
'End If
Application.Dialogs(xlDialogPrint).Show
keindruck:
Rows("1:1").EntireRow.HorizontalAlignment = xlLeft
'Strichlierungen entfernen
Rows("1:1").Borders(xlEdgeBottom).LineStyle = xlNone
Cells.EntireColumn.Borders(xlEdgeTop).LineStyle = xlNone
Cells.EntireColumn.Borders(xlInsideVertical).LineStyle = xlNone
Cells.EntireColumn.Borders(xlInsideHorizontal).LineStyle = xlNone
Cells.EntireColumn.Borders(xlEdgeRight).LineStyle = xlNone
Cells.EntireColumn.Borders(xlEdgeLeft).LineStyle = xlNone
ErrorHandler:
On Error GoTo 0
End Sub

Anzeige
AW: Drop Down - Arbeitsblaetter auswaehlen
21.06.2013 18:22:45
tuska
Hallo,
mich würde das Makro auch sehr interessieren. Leider erhalte ich unter Excel 2003 nach Aufruf immer die Fehlermeldung "Microsoft Excel kann das Makro "tabelle_einblenden ("Blattname")" nicht finden.
Ich habe nur den Code in "DieseArbeitsmappe" kopiert.
Weiß jemand Rat?
Gruß
Karl

AW: Drop Down - Arbeitsblaetter auswaehlen
21.06.2013 18:31:25
Martin
hallo karl!
so war der urspruengliche code (hab ich im netz gefunden), und NoNet hat ihn mir dann entsprechend meiner anforderung geaendert/verbessert.
ich hoffe du kannst damit was anfangen!
lg martin
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Call menu_tabellen
End Sub
Private Sub Workbook_Open()
Call menu_tabellen
End Sub
folgende zeilen in neu zu erstellendes modul:
Public Sub menu_tabellen()
Dim sheet As Worksheet
With Application.CommandBars(1)
On Error Resume Next
.Controls("&Tabellen").Delete
On Error GoTo 0
With .Controls.Add( _
Type:=msoControlPopup, _
before:=.Controls("&?").Index, _
temporary:=True)
.Caption = "&Tabellen"
For Each sheet In Sheets
With .Controls.Add(Type:=msoControlButton)
.Caption = sheet.Name
.Style = msoButtonCaption
.OnAction = "'tabelle_einblenden (""" & sheet.Name & """)'"
.State = msoButtonUp
End With
Next sheet
End With
End With
End Sub
Public Sub tabelle_einblenden(auswahl As String)
Dim sheet As Worksheet
Sheets(auswahl).Visible = xlSheetVisible
For Each sheet In Sheets
If sheet.Name  auswahl Then sheet.Visible = xlSheetHidden
Next sheet
End Sub
/pre>

Anzeige
AW: Drop Down - Arbeitsblaetter auswaehlen
21.06.2013 18:59:47
tuska
Hallo Martin,
danke für den Hinweis ... "folgende zeilen in neu zu erstellendes modul:".
Ich habe irrtümlich den gesamten Code in "DieseArbeitsmappe" kopiert, jetzt funktioniert der Code.
Vielen Dank!
Einen kleinen Wunsch hätte ich noch - vielleicht weiß jemand wie man das löst (habe es nur mit probieren nicht geschafft und bin kein Programmierer):
Bei dieser Variante wird das ausgewählte Blatt angezeigt und die übrigen Blätter ausgeblendet.
Ich hätte allerdings noch gerne dass das ausgewählte Blatt angezeigt wird und die übrigen Blätter NICHT ausgeblendet werden.
Gruß
Karl

Anzeige
AW: Drop Down - Arbeitsblaetter auswaehlen
21.06.2013 19:20:20
tuska
Habe zu meiner vorherigen Antwort nur vergessen, das Kontrollkästchen anzuhaken...
Einen kleinen Wunsch hätte ich noch - vielleicht weiß jemand wie man das löst (ich habe es probiert aber leider nicht geschafft - bin kein Programmierer):
Bei dieser Variante wird das ausgewählte Blatt angezeigt und die übrigen Blätter ausgeblendet.
Ich hätte allerdings noch gerne dass das ausgewählte Blatt angezeigt wird und die übrigen Blätter NICHT ausgeblendet werden.
Gruß
Karl

AW: Drop Down - Arbeitsblaetter auswaehlen
22.06.2013 09:42:02
fcs
Hallo Karl,
passe die folgende Prozedur an. dann werden keine Blätter ausgeblendet.
Gruß
Franz
Public Sub tabelle_einblenden(auswahl As String)
Sheets(auswahl).Visible = xlSheetVisible 'Diese Zeile ist wahrscheinlich nicht erforderlich
Sheets(auswahl).Activate
End Sub

Anzeige
AW: Drop Down - Arbeitsblaetter auswaehlen
22.06.2013 12:11:41
tuska
Hallo Franz,
dein Code funktioniert für mich perfekt.
Public Sub tabelle_einblenden(auswahl As String)
Sheets(auswahl).Activate
End Sub

Danke!
Gruß
Karl

AW: Drop Down - Arbeitsblaetter auswaehlen
22.06.2013 12:52:06
tuska
Hallo Franz,
nachdem der Code in einer Arb.Mappe mit 4 Blättern ohne Probleme funktioniert hat, habe ich einen Versuch mit 33 Arbeitsblättern gewagt - Doppelklick auf eine .xlt Datei mit vielen anderen Makros beinhaltet.
Als erstes erhalte ich hier den Laufzeitfehler '13': Typen unverträglich.
Nach Klick auf Button "Debuggen" bleibt der Cursor auf "Next Sheet" stehen (s. Dateianhang)
https://www.herber.de/bbs/user/85956.jpg

Wenn ich anstatt auf "Debuggen" auf Button "Beenden" klicke, dann funktioniert alles wie gewünscht.
Wie kann ich denn dieses Problem beheben? Bitte nochmals um Deine Unterstützung.
Gruß
Karl

Anzeige
AW: Drop Down - Arbeitsblaetter auswaehlen
22.06.2013 18:03:38
fcs
Hallo Karl,
ich kann nicht genau sagen warum es nicht funktioniert bei mehr Blättern.
Ändere mal die Zeile

For Each Sheet in Sheets
in

For Each sheet in ActiveWorkbook.Worksheets
Evtl hast du in der Datei auch Diagrammblätter, dann gibt es den Typfehler.
Alternativ kannst du die Variable anders deklarieren.
 Dim sheet as Worksheet
änern in
 Dim sheet as Object
Gruß
Franz

Anzeige
AW: Drop Down - Arbeitsblaetter auswaehlen
23.06.2013 11:54:40
tuska
Hallo Franz,
For Each sheet in ActiveWorkbook.Worksheets
war für mich schon die Lösung, die den Laufzeitfehler verschwinden ließ. Diagrammblätter hatte ich keine in den Arb.Mappen.
Herzlichen Dank für Deine Bemühungen, jetzt funktioniert für mich alles perfekt!
Gruß
Karl

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige