Afdrukken naar andere printer

Status
Niet open voor verdere reacties.

GervdOuweland

Gebruiker
Lid geworden
1 nov 2017
Berichten
6
Hallo Allemaal,

Sinds een aantal weken ben ik frequent bezoeker van dit forum, en ik heb er al heel veel nuttige tips en informatie uit kunnen halen. Helaas ben ik nu gestrand. Ik heb het onderstaande stukje code gemaakt, en dit doet wat het moet doen. Tot zover geen probleem.

Nu wil ik dat deze op een Zebra-printer afgedrukt worden. Het papierformaat is ingesteld en het afdrukbereik zit in de code, maar ik krijg niet het regeltje gevonden waarmee ik die printer laat selecteren.

Sub AfdrukkenLabels()

' Afdrukken Bundelkaarten

With Sheets("Pakketlabel")
ActiveSheet.PageSetup.PrintArea = "$A$1:$P$14"
For i = 1 To .Range("H13").Value
.Range("F13") = i
.PrintOut
Next
ActiveSheet.PageSetup.PrintArea = "$A$15:$P$28"
For i = 1 To .Range("H27").Value
.Range("F27") = i
.PrintOut
Next
ActiveSheet.PageSetup.PrintArea = "$A$29:$P$42"
For i = 1 To .Range("H41").Value
.Range("F41") = i
.PrintOut
Next
ActiveSheet.PageSetup.PrintArea = "$A$43:$P$56"
For i = 1 To .Range("H55").Value
.Range("F55") = i
.PrintOut
Next
ActiveSheet.PageSetup.PrintArea = "$A$57:$P$70"
For i = 1 To .Range("H69").Value
.Range("F69") = i
.PrintOut
Next
ActiveSheet.PageSetup.PrintArea = "$A$71:$P$84"
For i = 1 To .Range("H83").Value
.Range("F83") = i
.PrintOut
Next
ActiveSheet.PageSetup.PrintArea = "$A$85:$P$98"
For i = 1 To .Range("H97").Value
.Range("F97") = i
.PrintOut
Next
ActiveSheet.PageSetup.PrintArea = "$A$99:$P$112"
For i = 1 To .Range("H111").Value
.Range("F111") = i
.PrintOut
Next
ActiveSheet.PageSetup.PrintArea = "$A$113:$P$126"
For i = 1 To .Range("H125").Value
.Range("F125") = i
.PrintOut
Next
End With
End Sub

En inderdaad. dezelfde opdracht word 9 keer opnieuw uitgevoerd , alleen op een ander bereik. Als dit korter kan sta ik open voor suggesties.

Alvast bedankt voor alle hulp.
 
Even uit de losse pols, om de code in te korten:

Code:
Sub AfdrukkenLabels()

 ' Afdrukken Bundelkaarten

 With Sheets("Pakketlabel")
    Set startrange = .Range("$A$1:$P$14")
    Set startcel = .Range("H13")
        For j = 0 To 8
        .PageSetup.PrintArea = startrange.offset(j).address
            For i = 1 To startcel.offset(j).value
                startcel.offset(j * 14, -2).value = i
                .PrintOut
            Next i
         Next j
    End With
End Sub
 
Code:
Sub M_snb()
   for j=0 to 8
     Sheets("Pakketlabel").range("$A$1:$P$14").offset(14*j).printout
   next
End sub
 
Bedankt voor de tips. Helaas wil het nog niet lukken om die printer geselecteerd te krijgen.

Overal waar ik kom lees ik dat ik een printernaam en poort moet opgeven, maar bij elke combinatie die ik probeer krijg ik een foutmelding op de regel die de printer selecteert.
Het is me ook niet helemaal duidelijk op welke regel ik die code in zou moeten voegen.

Kan het ermee te maken dat hebben dat het om een netwerkprinter gaat die in het domein geregistreerd is?

Alle hulp is welkom.
 
....wil het nog niet lukken om die printer geselecteerd te krijgen.

Verklap dan eens wat je dan allemaal met welk je zonder succes geprobeerd hebt.
 
Laatst bewerkt:
Hoi Allemaal.

Het heeft iets langer geduurd. Door extreme drukte op andere projecten heeft dit project een weekje stil. Heb het nu weer opgepakt en ben wat aan het stoeien geweest. En niet zonder resultaat!
Ik heb onderstaande code:

Sub AfdrukkenLabels()

' Afdrukken Bundelkaarten
With Sheets("Pakketlabel")
Set startrange = .Range("$A$5:$H$5")
Set startcel = .Range("H5")
For j = 0 To 8
.PageSetup.PrintArea = startrange.Offset(j).Address
For i = 1 To startcel.Offset(j).Value
startcel.Offset(j * 1, -2).Value = i
.PrintOut Copies:=2
Next i
Next j
End With
End Sub

Dit werkt helemaal zoals het moet. Bedankt voor de tips hierboven. Maar wat hij niet doet is waar ik dit draadje voor heb geopend, namelijk het naar een andere printer sturen.
Als ik {.PrintOut Copies:=2} vervang door {.PrintOut ActivePrinter:="Labelprinter CL2 op 192.168.15.10", Copies:=2} krijg ik geen foutmelding, maar word het document afgedrukt op mijn standaard printer.
Als ik er {.PrintOut ActivePrinter:="ZM400 200dpi op 192.168.15.10", Copies:=2} heeft dit hetzelfde resultaat.
Nu maak ik er {.PrintOut ActivePrinter:="Microsoft print to PDF", Copies:=2} van, en is er geen vuiltje aan de lucht.
Ook met {.PrintOut ActivePrinter:="Send to OneNote 2016", Copies:=2} doet ie alles goed.

De oplossing ligt dus in het IP-adres en/of netwerklocatie in de printernaam.

Ik heb alleen nog een probleem ontdekt. De printer die ik hier selecteer word automatisch de standaardprinter (Windows 10).
Kan ik dit corrigeren met een regeltje in de zin van "STDprinter = ..." aan het eind van mijn code?
 
Voeg onderstaande code (uit linkje van post #4) eens toe aan de module waar Afdrukkenlabels staat en draai de Sub test_GetPrinterFullName eens


Code:
Private Sub test_GetPrinterFullName()
    Dim sPrinter As String
    Dim sDefaultPrinter As String
    Debug.Print "Default printer: ", Application.ActivePrinter
    sDefaultPrinter = Application.ActivePrinter ' store default printer
    sPrinter = GetPrinterFullName("[COLOR="#FF0000"]Labelprinter[/COLOR]")
    If sPrinter = vbNullString Then ' no match
        Debug.Print "No match"
    Else
        Application.ActivePrinter = sPrinter
        Debug.Print "Temp printer: ", Application.ActivePrinter
        ' do something with the temp printer
        
[COLOR="#FF0000"]        AfdrukkenLabels[/COLOR]
        
        Application.ActivePrinter = sDefaultPrinter ' restore default printer
    End If
    Debug.Print "Default printer: ", Application.ActivePrinter
End Sub
 
Public Function GetPrinterFullName(Printer As String) As String
 
    ' This function returns the full name of the first printerdevice that matches Printer.
    ' Full name is like "PDFCreator on Ne01:" for a English Windows and like
    ' "PDFCreator sur Ne01:" for French.
    ' Created: Frans Bus, 2015. See http://pixcels.nl/set-activeprinter-excel
    ' see http://blogs.msdn.com/b/alejacma/archive/2008/04/11/how-to-read-a-registry-key-and-its-values.aspx
    ' see http://www.experts-exchange.com/Software/Microsoft_Applications/Q_27566782.html
 
    Const HKEY_CURRENT_USER = &H80000001
    Dim regobj As Object
    Dim aTypes As Variant
    Dim aDevices As Variant
    Dim vDevice As Variant
    Dim sValue As String
    Dim v As Variant
    Dim sLocaleOn As String
     
    ' get locale "on" from current activeprinter
    v = Split(Application.ActivePrinter, Space(1))
    sLocaleOn = Space(1) & CStr(v(UBound(v) - 1)) & Space(1)
     
    ' connect to WMI registry provider on current machine with current user
    Set regobj = GetObject("WINMGMTS:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
     
    ' get the Devices from the registry
    regobj.EnumValues HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", aDevices, aTypes
     
    ' find Printer and create full name
    For Each vDevice In aDevices
        ' get port of device
        regobj.GetStringValue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", vDevice, sValue
        ' select device
        If Left(vDevice, Len(Printer)) = Printer Then ' match!
            ' create localized printername
            GetPrinterFullName = vDevice & sLocaleOn & Split(sValue, ",")(1)
            Exit Function
        End If
    Next
     
    ' at this point no match found
    GetPrinterFullName = vbNullString
 
End Function
 
Liever niet aan het register komen en zeker niet met zoveel code.

Code:
Sub M_printers()
  For Each pr In CreateObject("Wscript.network").EnumPrinterConnections
    c00 = c00 & vbLf & pr
  Next

  MsgBox c00
End Sub
 
Hallo Allemaal,

Het is gelukt. Alles werkt nu naar wens. Dit is het geworden:


PHP:
Sub AfdrukkenLabels()
'onthoud de standaard active printer
Dim strCurrentPrinter As String, j As Long
    strCurrentPrinter = Application.ActivePrinter
    
For j = 1 To 20
On Error Resume Next
Application.ActivePrinter = "\\192.168.15.10\Labelprinter CL2 op Ne" & Format(j, "00") & ":"
Next j

' Afdrukken Bundelkaarten
 With Sheets("Pakketlabel")
    Set startrange = .Range("$A$5:$H$5")
    Set startcel = .Range("H5")
        For j = 0 To 8
        .PageSetup.PrintArea = startrange.Offset(j).Address
            For i = 1 To startcel.Offset(j).Value
                startcel.Offset(j * 1, -2).Value = i
                .PrintOut Copies:=2
                Next i
         Next j
    End With
'terug naar de standaard printer
Application.ActivePrinter = strCurrentPrinter ' terug naar de standaard printer
End Sub

Toegelicht:
Ik heb niet de code gebruikt die werd genoemd om de printernaam en het "Ne"nr uit het register te halen, maar heb het rechtstreeks opgezocht. net zo makkelijk en is toch maar een eenmalige actie.
Meteen zover aangepast dat andere gebruikers niet tegen hetzelfde probleem lopen.

En onderaan ook het antwoord op mijn laatste vraag om de printer terug te zetten naar standaard.

Allemaal hartelijk bedankt. Ik ga er een slotje aan hangen.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan