AW: Zwei Loops zusammenfügen
23.10.2013 21:27:09
fcs
Hallo Thomas,
du mussten die Schleifen doch ziemlich umgebaut werden, damit es funktioniert.
Die vielen Sheet-Activate hab ich ebenfalls beseitigt durch With ... End With-Konstrukte.
mfg
Franz
Sub pdf_druck_vm_test_allesdrucken() '3 Blätter drucken
Dim VMmaxS%, VMmaxZ&, RMmaxS%, RMmaxZ&, DatNam$
Dim Anfang&, Zeile&, AktVG As Byte, FilAktVG As Byte
Dim FilMaxS&, FilMaxZ&, FilAnfang&, FilZeile&
'VM Druckbereich setzen
With Sheets("VD")
VMmaxS = .Cells(3, 1).CurrentRegion.Columns.Count
VMmaxZ = .Cells(3, 1).CurrentRegion.Rows.Count
.PageSetup.PrintArea = .Range(.Cells(1, 1), .Cells(VMmaxZ, VMmaxS))
End With
'Fil Einstellungen
With Sheets("Fil.")
FilMaxS = .Cells(3, 1).CurrentRegion.Columns.Count
FilMaxZ = .Cells(3, 1).CurrentRegion.Rows.Count
FilAnfang = 3
FilZeile = 3
FilAktVG = .Cells(FilZeile, 4) 'Fil. Druckbereich setzen
End With
'RM Einstellungen
With Sheets("RM")
RMmaxS = .Cells(3, 1).CurrentRegion.Columns.Count
RMmaxZ = .Cells(3, 1).CurrentRegion.Rows.Count
Anfang = 3
Zeile = 3
AktVG = .Cells(Zeile, 4) 'RM Druckbereich setzen
End With
Do
Application.StatusBar = "Erstelle PDF-Datei für " & AktVG
With Sheets("RM")
Do
If .Cells(Zeile + 1, 4) "" And .Cells(Zeile + 1, 4) AktVG Then
.PageSetup.PrintArea = _
.Range(.Cells(Anfang, 1), .Cells(Zeile, RMmaxS)).Address
Exit Do
End If
Zeile = Zeile + 1
Loop Until Zeile > RMmaxZ
End With
With Sheets("Fil.")
Do
If .Cells(FilZeile + 1, 4) "" And .Cells(FilZeile + 1, 4) FilAktVG Then
.PageSetup.PrintArea = _
.Range(.Cells(FilAnfang, 1), .Cells(FilZeile, FilMaxS)).Address
Exit Do
End If
FilZeile = FilZeile + 1
Loop Until FilZeile > FilMaxZ
End With
'Blätter Markieren
Sheets(Array("VD", "RM", "Fil.")).Select
'PDF erstellen
DatNam = "C:\" & "Umsatz_FB_VG" & AktVG & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=DatNam, _
Quality:=xlQualityMinimum, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
With Sheets("RM") 'RM Parameter ändern
'Hier If da Hr. Holzleitner keine Zahl
If IsNumeric(.Cells(Zeile + 1, 4)) Then
AktVG = .Cells(Zeile + 1, 4)
Anfang = Zeile + 1
Else
AktVG = .Cells(Zeile + 2, 4)
Anfang = Zeile + 2
End If
End With
With Sheets("Fil.") 'Fil. Parameter ändern
'Hier If da Hr. Holzleitner keine Zahl
If IsNumeric(.Cells(FilZeile + 1, 4)) Then
FilAktVG = .Cells(FilZeile + 1, 4)
FilAnfang = FilZeile + 1
Else
FilAktVG = .Cells(FilZeile + 2, 4)
FilAnfang = FilZeile + 2
End If
End With
Zeile = Zeile + 1
FilZeile = FilZeile + 1
Sheets("VD").Select
Loop Until Zeile >= RMmaxZ - 1
Application.StatusBar = False
End Sub