The attached project works perfectly with Windows XP and PDFCreator ver. 1.5
Prints on paper or create a PDF file, using the same code (Sub PrintTwoMedia)
It does not quite make it work with Windows Seven and PDFCreator (ver. 1.5 or 1.73)
Can anyone help?
Thanks in advance
’===============================================================================
’ Create a PDF or print to paper
’ To create the file or print on paper uses the same code
’ You have to insert a reference to C:\Program Files\PDFCreator\PDFCreator.EXE
’===============================================================================
Option Explicit
Private WithEvents PDFCreator1 As PDFCreator.clsPDFCreator
Private pErr As clsPDFCreatorError, opt As clsPDFCreatorOptions
Private noStart As Boolean, fac As Double, StartTime As Date
Private Declare Function GetProfileString Lib “kernel32” Alias “GetProfileStringA” (ByVal lpAppName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
Private Declare Function GetPrivateProfileString Lib “kernel32” Alias “GetPrivateProfileStringA” (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Sub Sleep Lib “kernel32” (ByVal dwMilliseconds As Long)
Private Type WindowsDevice
WindowsDeviceUserName As String
WindowsDeviceShortName As String
WindowsDevicePortName As String
End Type
Const WINDOWS_SECTION_NAME = “windows"
Const DEVICE_KEY_NAME = “device"
Sub PrintTwoMedia()
'— This sub is launched by both buttons
Printer.ScaleMode = 6
Printer.CurrentX = 10: Printer.CurrentY = 100
Printer.FontName = “Arial”: Printer.FontSize = 14
Printer.Print “TEST"
End Sub
Private Sub ButtonCreatePDF_Click()
Dim OldP As String
Dim PP As Printer
Dim OrgPrinter As WindowsDevice
Dim FolderPDF As String
Dim FileNamePDf As String
Dim Z As Long
FolderPDF = App.Path
FileNamePDf = “TEST_PDF.pdf”
Call GetDefaultPrinter(OrgPrinter)
OldP = OrgPrinter.WindowsDeviceUserName
With opt
.AutosaveDirectory = FolderPDF
.AutosaveFilename = FileNamePDf
.UseAutosave = 1
.UseAutosaveDirectory = 1
.AutosaveFormat = 0
End With
Set PDFCreator1.cOptions = opt
Set Printer = Printers(PrinterIndex(“PDFCreator”))
With Printer
.ScaleMode = 6
.PrintQuality = 150
End With
'-----------------
PrintTwoMedia
'-----------------
Printer.EndDoc
PDFCreator1.cPrinterStop = False
Do
Z = DoEvents()
Loop Until Dir$(FolderPDF + “/” + FileNamePDf) <> “”
PDFCreator1.cPrinterStop = False
'— Restoring the default printer
For Each PP In Printers
If UCase(PP.DeviceName) Like UCase(OldP) Then
Set Printer = PP
Exit For
End If
Next
PDFCreator1.cClose
While PDFCreator1.cProgramIsRunning
DoEvents
Sleep 100
Wend
DoEvents
Set PDFCreator1 = Nothing
Set pErr = Nothing
Set opt = Nothing
MsgBox (“END”)
End Sub
Private Sub ButtonPrintOnPaper_Click()
PrintTwoMedia
Printer.EndDoc
MsgBox (“END”)
End Sub
Private Sub GetDefaultPrinter(recDefaultPrinter As WindowsDevice)
Dim StrPos As Integer
Dim DefaultPrinter As String
’
DefaultPrinter = GetString(WINDOWS_SECTION_NAME, DEVICE_KEY_NAME, “”, “”)
StrPos = InStr(DefaultPrinter, “,”)
recDefaultPrinter.WindowsDeviceUserName = Left$(DefaultPrinter, StrPos - 1)
DefaultPrinter = Mid$(DefaultPrinter, StrPos + 1)
StrPos = InStr(DefaultPrinter, “,”)
recDefaultPrinter.WindowsDeviceShortName = Left$(DefaultPrinter, StrPos - 1)
recDefaultPrinter.WindowsDevicePortName = Mid$(DefaultPrinter, StrPos + 1)
End Sub
Private Function PrinterIndex(Printername As String) As Long
Dim i As Long
For i = 0 To Printers.Count - 1
If UCase(Printers(i).DeviceName) = UCase$(Printername) Then
PrinterIndex = i
Exit For
End If
Next i
End Function
Function GetString(SectionName As String, KeyName As String, DefaultValue As String, ProfileName As String) As String
Dim KeyValueLength As Integer
Dim KeyValue As String
KeyValue = Space$(256)
If Trim$(ProfileName) = “” Then
KeyValueLength = GetProfileString(SectionName, KeyName, DefaultValue, KeyValue, Len(KeyValue))
Else
KeyValueLength = GetPrivateProfileString(SectionName, KeyName, DefaultValue, KeyValue, Len(KeyValue), ProfileName)
End If
GetString = Left$(KeyValue, KeyValueLength)
End Function
Private Sub Form_Load()
Set PDFCreator1 = New clsPDFCreator
Set pErr = New clsPDFCreatorError
With PDFCreator1
.cVisible = True
If .cStart(”/NoProcessingAtStartup”) = False Then
If .cStart(”/NoProcessingAtStartup", True) = False Then
Exit Sub
End If
.cVisible = True
End If
’ Get the options
Set opt = .cOptions
.cClearCache
noStart = False
End With
End Sub
No one is able to give an answer ?
I got this to work using VB6 and Win7 by synching versions and installed locations between DEV and DEPLOY machines