Excel mit VBA in PDF speichern, geänderter Bezug, was dann?

12/02/2010 - 18:49 von Sepp, Salzburg | Report spam
Liebe Experten,

wenn ich mit VBA ein PDF Format generiere sieht der Code wie folgt aus:

Application.ActivePrinter = "Adobe PDF auf Ne06:"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
"Adobe PDF auf Ne06:", Collate:=True

Mein Problem:

Wird der PC oder der Drucker gewechselt àndert sich meistens der Bezug,
z.B von Ne03 auf Ne04, d.h. das Makro funktioniert nicht mehr und muss
angepasst werden.

Gibt es eine Möglichkeit den Code so zu erstellen, dass der Bezug immer
richtig ist?

Ich arbeite mit Excel 2003, SP3, Windows XP

Im Voraus besten Dank für Eure Mühe und schöne Grüße aus Salzburg

Sepp, Salzburg
 

Lesen sie die antworten

#1 Andreas Killer
12/02/2010 - 19:29 | Warnen spam
Sepp schrieb:

Application.ActivePrinter = "Adobe PDF auf Ne06:"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
"Adobe PDF auf Ne06:", Collate:=True

Wird der PC oder der Drucker gewechselt àndert sich meistens der Bezug,
z.B von Ne03 auf Ne04, d.h. das Makro funktioniert nicht mehr und muss
angepasst werden.

Gibt es eine Möglichkeit den Code so zu erstellen, dass der Bezug immer
richtig ist?


Es ist möglich alle Drucker des System's zu ermitteln und aus diesen
könnte man den geeigneten auswàhlen, z.B. wenn der Name PDF enthàlt.

Kopier mal den angehàngten Code in ein Modul und starte die "Sub
Test". Wenn Sie "Adobe PDF auf Ne06:" ausgibt sollte es auf anderen
System auch gehen.

Andreas.

Private Declare Function lstrcpy Lib "kernel32.dll" Alias _
"lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As _
Long) As Long
Private Declare Function lstrlen Lib "kernel32.dll" Alias _
"lstrlenA" (ByVal lpString As Long) As Long
Private Declare Function EnumPrinters Lib "winspool.drv" Alias _
"EnumPrintersA" (ByVal flags As Long, ByVal name As String, _
ByVal Level As Long, pPrinterEnum As Long, ByVal cdBuf As _
Long, pcbNeeded As Long, pcReturned As Long) As Long
Private Const PRINTER_ENUM_LOCAL = &H2
Private Type PRINTER_INFO_1
flags As Long
pDescription As String
pName As String
pComment As String
End Type

Public Function GetPDFPrinterName() As String
Dim longbuffer() As Long
Dim printinfo() As PRINTER_INFO_1
Dim numbytes As Long, numneeded As Long, numprinters As Long
Dim c As Integer, retval As Long
numbytes = 3076 ' should be sufficiently big, but it may _
not be
ReDim longbuffer(0 To numbytes / 4) As Long
retval = EnumPrinters(PRINTER_ENUM_LOCAL, "", 1, longbuffer( _
0), numbytes, numneeded, numprinters)
' try enlarging longbuffer() to receive all necessary _
information
If retval = 0 Then
numbytes = numneeded
' make it large enough
ReDim longbuffer(0 To numbytes / 4) As Long
retval = EnumPrinters(PRINTER_ENUM_LOCAL, "", 1, _
longbuffer(0), numbytes, numneeded, numprinters)
If retval = 0 Then
' failed again!
Exit Function
End If
End If

' Convert longbuffer() data into printinfo()
If numprinters <> 0 Then
' room for each printer
ReDim printinfo(0 To numprinters - 1) As PRINTER_INFO_1
End If
For c = 0 To numprinters - 1
' longbuffer(4 * c) = .flags, longbuffer(4 * c + 1) = _
.pDescription, etc.
' For each string, the string is first buffered to provide _
enough room, and then the string is copied.
printinfo(c).flags = longbuffer(4 * c)
printinfo(c).pDescription = Space(lstrlen(longbuffer(4 * c _
+ 1)))
retval = lstrcpy(printinfo(c).pDescription, longbuffer(4 * _
c + 1))
printinfo(c).pName = Space(lstrlen(longbuffer(4 * c + 2)))
retval = lstrcpy(printinfo(c).pName, longbuffer(4 * c + 2))
printinfo(c).pComment = Space(lstrlen(longbuffer(4 * c + 3)))
retval = lstrcpy(printinfo(c).pComment, longbuffer(4 * c + _
3))
Next c
' Display name of each printer
For c = 0 To numprinters - 1
'Debug.Print "Name of printer"; c + 1; " is: "; printinfo( _
c).pName
If InStr(1, printinfo(c).pName, "PDF", vbTextCompare) > 0 _
Then
GetPDFPrinterName = printinfo(c).pName
Exit Function
End If
Next c
End Function

Sub Test()
MsgBox GetPDFPrinterName
End Sub

Ähnliche fragen