Makro kürzen???

Forumthread: Makro kürzen?

Makro kürzen?

15.08.2004 20:40:51

Max

Hallo Leute,
kann man dieses Makro auch kürzer Schreiben?
Das ganze geht von Zelle A120 bis A610.


Sub Drucken()
Application.ScreenUpdating = False
If [a120] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$120:$X$128"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a130] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$130:$X$138"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a140] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$140:$X$148"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a150] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$150:$X$158"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a160] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$160:$X$168"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a170] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$170:$X$178"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a180] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$180:$X$188"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a190] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$190:$X$198"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a200] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$200:$X$208"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a210] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$210:$X$218"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a220] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$220:$X$228"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a230] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$230:$X$238"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a240] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$240:$X$248"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a250] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$250:$X$258"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a260] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$260:$X$268"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a270] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$270:$X$278"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a280] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$280:$X$288"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a290] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$290:$X$298"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a300] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$300:$X$308"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a310] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$310:$X$318"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a320] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$320:$X$328"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a330] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$330:$X$338"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a340] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$340:$X$348"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a350] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$350:$X$358"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a360] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$360:$X$368"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a370] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$370:$X$378"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a380] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$380:$X$388"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a390] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$390:$X$398"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a400] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$400:$X$408"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
Application.ScreenUpdating = True
End 

Sub
Max M.

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Makro kürzen?

Ulf
AW: Makro kürzen?

Max
AW: Makro kürzen?

15.08.2004 20:54:59

Klaus-Dieter
AW: Makro kürzen?

Max
Was hattest du erwartet? ;-) o.T.

15.08.2004 21:26:22

Klaus-Dieter

AW: Makro kürzen?

Ulf

Ungestet, sollte aber funktionieren:
Option Explicit


Sub drucken_Step10()
Dim z As Long
For z = 120 To 400 Step 10
If Cells(z, 1) = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$" & z & ":$X$" & z + 8
ActiveSheet.PrintOut Copies:=1, Collate:=True
End If
End Sub

Ulf

AW: Makro kürzen?

Max

Hallo Ulf,
danke für deine Antwort.
Es funktioniert, habe nur noch Next z hinzugefügt.
Gruß Max.

AW: Makro kürzen?

15.08.2004 20:54:59

Klaus-Dieter

Hallo Max,
kurz genug?


Sub test()
Dim s As Integer
For s = 120 To 610 Step 10
If Cells(s, 1) = "x" Then
Range("B" & s, "X" & s + 8).PrintOut Copies:=1, Collate:=True
End If
Next s
End Sub

Gruß Klaus-Dieter

AW: Makro kürzen?

Max

Hallo Klaus Dieter,
danke, auch dein verkürztes Makro funktioniert.
Gruß Max.

Was hattest du erwartet? ;-) o.T.

15.08.2004 21:26:22

Klaus-Dieter

Beliebteste Forumthreads (12 Monate)

Forumthread: Makro kürzen?

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread