Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema Image
BildScreenshot zu Image Image-Seite mit Beispielarbeitsmappe aufrufen

Makro kürzen???

Betrifft: Makro kürzen??? von: Max M.
Geschrieben am: 15.08.2004 20:40:51

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.


  


Betrifft: AW: Makro kürzen??? von: Ulf
Geschrieben am: 15.08.2004 20:48:32

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


  


Betrifft: AW: Makro kürzen??? von: Max M.
Geschrieben am: 15.08.2004 20:56:49

Hallo Ulf,

danke für deine Antwort.
Es funktioniert, habe nur noch Next z hinzugefügt.

Gruß Max.


  


Betrifft: AW: Makro kürzen??? von: Klaus-Dieter
Geschrieben am: 15.08.2004 20:54:59

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

Klaus-Dieter's Excel und VBA Seite


  


Betrifft: AW: Makro kürzen??? von: Max M.
Geschrieben am: 15.08.2004 21:00:03

Hallo Klaus Dieter,

danke, auch dein verkürztes Makro funktioniert.

Gruß Max.


  


Betrifft: Was hattest du erwartet? ;-) o.T. von: Klaus-Dieter
Geschrieben am: 15.08.2004 21:26:22