VisualBasic [Excel] For Each Schleife wird übersprungen

Suchtbolzen

Lieutenant
Registriert
Jan. 2012
Beiträge
636
Moin,

wusste jetzt nicht ob das evtl. in den Office Bereich gehört.. wenn ja bitte verschieben.

Es geht um folgendes:

Ein Kollege und ich bräuchten Hilfe bei einem Excel Makro (die verwendete Excel Version ist übrigens 2010).
Mein Kollege hatte sich ein Makro geschrieben was in allen Arbeitsblättern (also Tabellen) die Kopf und Fußzeile festlegt.
Soweit so gut, hat auch funktioniert allerdings nicht gerade sehr schnell.
Über Google ist er nun auf folgendes Makro gestoßen welches bedeutend schneller ist als seins:

Code:
Sub xl4PageSetup()
Dim Foot_L As String, Foot_C As String, Foot_R As String
Dim head As String, foot As String, pLeft As String, pRight As String, Top As String, _
Bot As String, hdng As String, grid As String, h_cntr As String, v_cntr As String, _
orient As String, paper_size As String, pscale As String, pg_num As String, _
pg_order As String, bw_cells As String, quality As String, head_margin As String, _
foot_margin As String, Notes As String, Draft As String
Dim pSetUp As String, ws As Worksheet
   With ActiveSheet.PageSetup
      Foot_L = .LeftFooter
      Foot_C = .CenterFooter
      Foot_R = .RightFooter
   End With
 
   'head = """"""
   foot = """&L&8&F, &A, &D, &T&C" & Foot_C & "&R" & Foot_R & """"
   pLeft = "0.69"
   pRight = "0.38"
   Top = "0.47"
   Bot = "0.47"
   hdng = "False"
   grid = "False"
   h_cntr = "True"
   v_cntr = "False"
   orient = 1
   paper_size = 9
   pscale = "True"
   pg_num = ""
   pg_order = ""
   bw_cells = ""
   quality = ""
   head_margin = "0.37"
   foot_margin = "0.27"
   Notes = "False"
   Draft = "False"
 
   pSetUp = "Page.Setup(" & head & "," & foot & "," & pLeft & ","
   pSetUp = pSetUp & pRight & "," & Top & "," & Bot & "," & hdng & ","
   pSetUp = pSetUp & grid & "," & h_cntr & "," & v_cntr & ","
   pSetUp = pSetUp & orient & "," & paper_size & "," & pscale & ","
   pSetUp = pSetUp & pg_num & "," & pg_order & "," & bw_cells & ","
   pSetUp = pSetUp & quality & "," & head_margin & ","
   pSetUp = pSetUp & foot_margin & "," & Notes & "," & Draft & ")"
 
   Set ws = ActiveSheet
 
   Application.ExecuteExcel4Macro pSetUp
 
End Sub

Dieses Makro setzt allerdings nur die Kopfzeile bei der aktuell aktiven Tabelle.

Nun haben wir versucht die For Each Schleife aus seinem alten Makro (natürlich leicht angepasst) in dieses Makro zu platzieren so das alle Tabellen mit der kopf und Fußzeile versehen werden.. leider bisher ohne Erfolg.

Wir haben die For Each Schleife sowohl in diesem Bereich versucht

Code:
 pSetUp = "Page.Setup(" & head & "," & foot & "," & pLeft & ","
   pSetUp = pSetUp & pRight & "," & Top & "," & Bot & "," & hdng & ","
   pSetUp = pSetUp & grid & "," & h_cntr & "," & v_cntr & ","
   pSetUp = pSetUp & orient & "," & paper_size & "," & pscale & ","
   pSetUp = pSetUp & pg_num & "," & pg_order & "," & bw_cells & ","
   pSetUp = pSetUp & quality & "," & head_margin & ","
   pSetUp = pSetUp & foot_margin & "," & Notes & "," & Draft & ")"

als auch in diesem.

Code:
Set ws = ActiveSheet
 
   Application.ExecuteExcel4Macro pSetUp

Unsere For Each Schleife sah so aus:

Code:
For Each ws In ActiveWorkbook.Worksheets
CODE

Next

Naja wie gesagt, hat bisher alles nicht funktioniert und nun fragen wir euch.

Danke schonmal im Voraus.

Suchtbolzen
 
For Each worksh In ActiveWorkbook.Worksheets
Set ws = worksh
Application.ExecuteExcel4Macro pSetUp

Next



das schon versucht?
 
DonnyDepp schrieb:
For Each worksh In ActiveWorkbook.Worksheets
Set ws = worksh
Application.ExecuteExcel4Macro pSetUp

Next

das schon versucht?

gerade ausprobiert, funktioniert leider auch nicht.
 
achso, das psetup bezieht sich immer nur aufs aktive sheet. und das set ws ist im prinzip überflüssig.

müsste also gehen mit:

Code:
Sub xl4PageSetup()
[Dims...]


For Each worksh In ActiveWorkbook.Worksheets

worksh.activate

With ActiveSheet.PageSetup
[...]
end with
[...]


Application.ExecuteExcel4Macro pSetUp
next

end sub
 
yeah, das hat funktioniert.

Vielen Dank. :)
 
Zurück
Oben