Office: (Office 2013) Drucken (Auswahl) mit Makro

Hallo zusammen

Ich drücke über ein Macro Momentan die Selektierten Blätter. Würde die Selektion gerne Automatisieren so das wenn z.B. in Zelle A1 ein "X" steht das Blatt selektiert wird.

Wie es mit festen Seiten geht ist klar

Sheets(Array("Deckblatt", "Rohdatenblatt Waage", "Ausgänge (Waage)", "Prüfblatt 1 (Waage)", "Prüfblatt 2 (Waage)", "Prüfblatt 3 (Waage)", "Prüfblatt 4 (Waage)")).Select

Hatte schon daran gedacht es so zu lösen
Auf der Startseite in A1 die einzelnen Seiten abzufragen und das Array zu bilden
A1 =VERKETTEN(AE4;AF4;AE5;AF5;AE6;AF6;AE7;AF7;AE8;AF8;AE9;AF9;AE10;AF10;AE12;AF12;AE13;AF13)

AE4 =WENN(Deckblatt!A1="X";"";"Deckblatt",)
AF4 = =WENN(Rohdatenblatt Waage!A1="X";"";"Rohdatenblatt Waage",)
usw.

Sheets(Array(("Startseite!A1"))).Select

aber das Klappt leider auch nicht.

stehe da gerade etwas auf dem schlauch.

Würde mich über Hilfe sehr freuen.

Sub Drucken_1()
'
' Drucken_der_ausgewählten_Blätter

'


Cells.Select

With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With


Selection.Interior.ColorIndex = xlNone
Sheets("Deckblatt").Activate
Application.ActivePrinter = "signotec PDF-Creator auf Ne00:"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False

Sheets("Deckblatt").Activate
DateiName = Range("Startseite!R23") & "" & Range("Startseite!R20") & Range("Startseite!R19") & ".pdf"

Sheets(Array("Rohdatenblatt Waage")).Select
Selection.Interior.ColorIndex = xlNone


Range("A1:W95").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
DateiName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
Sheets("Deckblatt").Activate

Sheets(Array("Startseite")).Select
Call Speichern_unter_Server
Sheets(Array("Deckblatt")).Select

End Sub

 

Hi,

das Array mit den zu selektierenden Blättern kannst du wie folgt erstellen:

Code:

Sub Tabellen_selektieren()
    Dim lngTabellen As Long
    Dim lngZaehler As Long
    Dim arrTabellen()
    lngZaehler = 1
    For lngTabellen = 1 To Worksheets.Count
        If Worksheets(lngTabellen).Range("A1") = "X" Then
            ReDim Preserve arrTabellen(1 To lngZaehler)
            arrTabellen(lngZaehler) = Worksheets(lngTabellen).Name
            lngZaehler = lngZaehler + 1
        End If
    Next lngTabellen
    Worksheets(arrTabellen()).Select
End Sub

Bis später,
Karin

 

Danke Klappt super