Ny ActivPrinter

Det må på en eller anden måde kræve nopget API programmering, som jeg ikke lige kan ryste ud af ærmet her og nu. Det er jo ikke Excel, der kender printerne men Windows, så koden må først hente listen i Windows, og dernæst analysere den for at finde de rigtige printere. Problemer opstår selvfølgelig i det tilfælde at flere printere alle indeholder HPxxxx.

Men google kan ofte hjælpe:

Denne kode skal kopieres til et modul:

Private Declare Function GetProfileString Lib "kernel32" _
        Alias "GetProfileStringA" _
        (ByVal lpAppName As String, ByVal lpKeyName As String, _
        ByVal lpDefault As String, ByVal lpReturnedString As String, _
        ByVal nSize As Long) As Long




Function PrinterList()
  Dim lRet        As Long
  Dim sBuffer    As String
  Dim lSize      As Long
  Dim avTmp      As Variant
  Dim aPrn()      As String
  Dim n%, sPrn$, sConn$, sPort$

  'Get localized Connection string
  avTmp = Split(Excel.ActivePrinter)
  sConn = " " & avTmp(UBound(avTmp) - 1) & " "
  'Get Printers
  lSize = 1024
  sBuffer = Space(lSize)
  lRet = GetProfileString("devices", vbNullString, vbNullString, _
    sBuffer, lSize)
  sBuffer = Left(sBuffer, lRet)
  avTmp = Split(sBuffer, Chr(0))

  ReDim Preserve avTmp(UBound(avTmp) - 1)
  For n = 0 To UBound(avTmp)
    lSize = 128
    sBuffer = Space(lSize)
    lRet = GetProfileString("devices", avTmp(n), vbNullString, _
      sBuffer, lSize)
    sPort = Mid(sBuffer, InStr(sBuffer, ",") + 1, _
      lRet - InStr(sBuffer, ","))
    avTmp(n) = avTmp(n) & sConn & sPort
  Next
  PrinterList = avTmp
End Function

Koden er lavet af Jim Reck.

For at sætte den aktive printer til en printer fra listen, der indeholder bogstaverne HP i navnet, kan du bruge denne makro, som kalder Jim's kode:


Sub SetPrinter()

  For Each p In PrinterList
      If InStr(p, "HP") Then ActivePrinter = p
  Next p

End Sub

Er der flere printere, der indeholder bogstaverne HP, sættes den sidste fundne som den aktive printer.

Hej jkrons
Det var helt perfekt og det fungere helt perfekt.
alle farveprintere er HP2500 og det finder den fint ud af
MVH
callevib

Glæder mig at kunne hjælpe. Lukker du lige?

Hejsa
Jeg har ikke rigtig styr på at lukke. Jeg har forsøgt at acceptere dit svar og håber at du nu får dine point. Eller vil jeg gerne høre hvordan jeg gør?
Jeg er supernovise her!

Det er præcis korrekt. Du lukker ved aty aceeptere et svar :-)