• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Macro finetunen

Status
Niet open voor verdere reacties.
B

budgie

Gebruiker
Lid geworden
24 dec 2007
Berichten
32
Als leek heb ik dankzij het forum "Help.nl" een exel bestand gemaakt (9Mb) met formules, lijsten, voorwaardelijke opmaak, draaitabellen en de laatste stap is een macro om vanuit een blad een bepaalde zone uit een ander blad te printen. Dit werkt goed maar blijkbaar niet perfect daar gedurende de uitvoering van de macro het beeld verspringt en ze nogal wat tijd in beslag neemt. wie kan me helpen om dit vlotter te laten gebeuren?
Code: 
Sub Kooietiketten()
    ThisWorkbook.RefreshAll
    sPrinter = Application.ActivePrinter
    Application.ActivePrinter = "EPSON ET-2750 Series op Ne04:"
'    Application.ActivePrinter = "doPDF 8 op Ne05:"
    Application.PrintCommunication = True
    With ActiveSheet.PageSetup
        .Orientation = xlPortrait
        .Zoom = 68
    End With
    Sheets("Kooietiketten 1").Select
If Sheets("Kooietiketten 1").Range("G2") = 16 Then
    Range("A2:I223").Select
    Selection.PrintOut Copies:=1, Collate:=True
    Sheets("TT_XL").Select
    MsgBox "16 Etiketten geprint"
End If
If Sheets("Kooietiketten 1").Range("G2") = 15 Then
    Range("A2:I210").Select
    Selection.PrintOut Copies:=1, Collate:=True
    Sheets("TT_XL").Select
    MsgBox "15 Etiketten geprint"
End If
If Sheets("Kooietiketten 1").Range("G2") = 14 Then
    Range("A2:I197").Select
    Selection.PrintOut Copies:=1, Collate:=True
    Sheets("TT_XL").Select
    MsgBox "14 Etiketten geprint"
End If
If Sheets("Kooietiketten 1").Range("G2") = 13 Then
    Range("A2:I184").Select
    Selection.PrintOut Copies:=1, Collate:=True
    Sheets("TT_XL").Select
    MsgBox "13 Etiketten geprint"
End If
If Sheets("Kooietiketten 1").Range("G2") = 12 Then
    Range("A2:I167").Select
    Selection.PrintOut Copies:=1, Collate:=True
    Sheets("TT_XL").Select
    MsgBox "12 Etiketten geprint"
End If
If Sheets("Kooietiketten 1").Range("G2") = 11 Then
    Range("A2:I154").Select
    Selection.PrintOut Copies:=1, Collate:=True
    Sheets("TT_XL").Select
    MsgBox "11 Etiketten geprint"
End If
If Sheets("Kooietiketten 1").Range("G2") = 10 Then
    Range("A2:I141").Select
    Selection.PrintOut Copies:=1, Collate:=True
    Sheets("TT_XL").Select
    MsgBox "10 Etiketten geprint"
End If
If Sheets("Kooietiketten 1").Range("G2") = 9 Then
    Range("A2:I128").Select
    Selection.PrintOut Copies:=1, Collate:=True
    Sheets("TT_XL").Select
    MsgBox "9 Etiketten geprint"
End If
If Sheets("Kooietiketten 1").Range("G2") = 8 Then
    Range("A2:I111").Select
    Selection.PrintOut Copies:=1, Collate:=True
    Sheets("TT_XL").Select
    MsgBox "8 Etiketten geprint"
End If
If Sheets("Kooietiketten 1").Range("G2") = 7 Then
    Range("A2:I98").Select
    Selection.PrintOut Copies:=1, Collate:=True
    Sheets("TT_XL").Select
    MsgBox "7 Etiketten geprint"
End If
If Sheets("Kooietiketten 1").Range("G2") = 6 Then
    Range("A2:I85").Select
    Selection.PrintOut Copies:=1, Collate:=True
    Sheets("TT_XL").Select
    MsgBox "6 Etiketten geprint"
End If
If Sheets("Kooietiketten 1").Range("G2") = 5 Then
    Range("A2:I72").Select
    Selection.PrintOut Copies:=1, Collate:=True
    Sheets("TT_XL").Select
    MsgBox "5 Etiketten geprint"
End If
If Sheets("Kooietiketten 1").Range("G2") = 4 Then
    Range("A2:I55").Select
    Selection.PrintOut Copies:=1, Collate:=True
    Sheets("TT_XL").Select
    MsgBox "4 Etiketten geprint"
End If
If Sheets("Kooietiketten 1").Range("G2") = 3 Then
    Range("A2:I42").Select
    Selection.PrintOut Copies:=1, Collate:=True
    Sheets("TT_XL").Select
    MsgBox "3 Etiketten geprint"
End If
If Sheets("Kooietiketten 1").Range("G2") = 2 Then
    Range("A2:I29").Select
    Selection.PrintOut Copies:=1, Collate:=True
    Sheets("TT_XL").Select
    MsgBox "2 Etiketten geprint"
End If
If Sheets("Kooietiketten 1").Range("G2") = 1 Then
    Range("A2:I16").Select
    Selection.PrintOut Copies:=1, Collate:=True
    Sheets("TT_XL").Select
    MsgBox "1 Etiket geprint"
End If
Application.ActivePrinter = sPrinter
End Sub
 
Zonder dat je een voorbeeld document hebt geplaatst.
Probeer het eens zo:
Code: 
Sub Kooietiketten()
    ThisWorkbook.RefreshAll
    sPrinter = Application.ActivePrinter
    Application.ActivePrinter = "EPSON ET-2750 Series op Ne04:"
[COLOR="#008000"]'    Application.ActivePrinter = "doPDF 8 op Ne05:"[/COLOR]
    Application.PrintCommunication = True
    With ActiveSheet.PageSetup
        .Orientation = xlPortrait
        .Zoom = 68
    End With
    
    With Sheets("Kooietiketten 1")
        Aantal = .Range("G2")
        Select Case Aantal
            Case 1: Set rng = .Range("A2:I16")
            Case 2: Set rng = .Range("A2:I29")
            Case 3: Set rng = .Range("A2:I42")
            Case 4: Set rng = .Range("A2:I55")
            Case 5: Set rng = .Range("A2:I72")
            Case 6: Set rng = .Range("A2:I85")
            Case 7: Set rng = .Range("A2:I98")
            Case 8: Set rng = .Range("A2:I111")
            Case 9: Set rng = .Range("A2:I128")
            Case 10: Set rng = .Range("A2:I141")
            Case 11: Set rng = .Range("A2:I154")
            Case 12: Set rng = .Range("A2:I167")
            Case 13: Set rng = .Range("A2:I184")
            Case 14: Set rng = .Range("A2:I197")
            Case 15: Set rng = .Range("A2:I210")
            Case 16: Set rng = .Range("A2:I223")
        End Select
    End With
        
    If Aantal > 0 And Aantal < 17 Then
        rng.PrintOut Copies:=1, Collate:=True
        MsgBox Aantal & " Etiket(ten) geprint"
    End If
    Application.ActivePrinter = sPrinter
    Sheets("TT_XL").Select
End Sub
 
Andere methode.
Code: 
Sub Kooietiketten()
    ThisWorkbook.RefreshAll
    sPrinter = Application.ActivePrinter
    Application.ActivePrinter = "EPSON ET-2750 Series op Ne04:"
'    Application.ActivePrinter = "doPDF 8 op Ne05:"
    'Application.PrintCommunication = True
 With Sheets("Kooietiketten 1")
  If .Range("g2") >= 1 And .Range("g2") <= 16 Then
     With .PageSetup
        .Orientation = xlPortrait
        .Zoom = 68
     End With
 sv = array("a2:i16", "a2:i29", "a2:i41", "a2:i55", "a2:i72", "a2:i85", "a2:i98", "a2:i111", "a2:i128", "a2:i141", "a2:i154", "a2:i167", "a2:184", "a2:i197", "a2:i210", "a2:i223")
 .Range(sv(.range("g2") - 1)).PrintOut
       Sheets("TT_XL").Select
       MsgBox .range("g2").Value & " Etiketten geprint"
  End If
 End With
Application.ActivePrinter = sPrinter
End Sub

Of:
Code: 
Sub Kooietiketten()
    ThisWorkbook.RefreshAll
    sPrinter = Application.ActivePrinter
    Application.ActivePrinter = "EPSON ET-2750 Series op Ne04:"
 '   Application.ActivePrinter = "doPDF 8 op Ne05:"
    Application.PrintCommunication = True
 With Sheets("Kooietiketten 1")
  If .Range("g2") >= 1 And .Range("g2") <= 16 Then
     With .PageSetup
        .Orientation = xlPortrait
        .Zoom = 68
     End With
  .Range("A2", .Cells((.Range("g2") + 1) * 13 - IIf(.Range("g2") < 5, 10, 6) + IIf(.Range("g2") > 12, 8, IIf(.Range("g2") > 8, 4, 0)), 9)).PrintOut
    Sheets("TT_XL").Select
    MsgBox .Range("g2").Value & " Etiketten geprint"
  End If
 End With
Application.ActivePrinter = sPrinter
End Sub
 
Laatst bewerkt:
Bedankt voor de snelle en perfect werkende oplossingen waarmee mijn programma 100% functioneel en gebruiksvriendelijk is.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan