Hi Hans. I have some code in my project already for printing. This prints the QR image but it stretches it to the width of the label.
There is a reference to the stretch properties in the code but I'm not 100% sure how this works, I also need to add the contents of the text control txtEST.
Can you see anything in the code to improve on?
Regards
Code: Select all
Private Function PrintImageFromFile(pFileName As String, Optional pOrientation As Long = 1, Optional pStretchImage As Boolean = False, Optional pEndDoc As Boolean = True) As Long
'
' pFileName contains the name of the file to print
' If pStretchImage is True then the image is stretched to fit the page.
' Orientation and EndDoc are self-explanatory.
'
' The routine assumes you've set the printer to the one you want and the paper size
' is set. Note that no allowances are made for unprintable areas on the page.
' I'm not sure about PostScript printers either. I haven't got one to test it on.
'
PrintImageFromFile = 0
If pFileName = vbNullString Then
Err.Raise 10001, "PrintImageFromFile", "Filename parameter is empty"
PrintImageFromFile = 1
End If
Dim lImageWidth As Long, lImageHeight As Long
Dim lPrinterWidth As Long, lPrinterHeight As Long
Dim sX As Single, sY As Single
Dim pbStd As StdPicture
On Error GoTo InvalidFileName
If Dir(pFileName, vbNormal) = vbNullString Then
Err.Raise 10002, "PrintImageFromFile", pFileName & " does not exist"
PrintImageFromFile = 2
End If
On Error GoTo 0
On Error GoTo InvalidPicture
Set pbStd = LoadPicture(pFileName)
On Error GoTo 0
Printer.ScaleMode = vbTwips ' Set the printer scale mode to Twips
'
' Set the orientation. 1 = Portrait, 2 = Landscape. Default is Portrait
'
' Make sure you do this before calculating anything based on the printer object
' as it changes the Height and Width properties.
'
On Error GoTo PrinterError ' If we can't set the orientation then
Select Case pOrientation ' I'm pretty sure we can't print the image.
Case 1
Printer.Orientation = 2
Case 2
Printer.Orientation = 2
Case Else
Printer.Orientation = 2
End Select
lPrinterWidth = Printer.ScaleWidth
lPrinterHeight = Printer.ScaleHeight
lImageWidth = pbStd.Width / 1.75 ' The 1.75 was found through experimentation
lImageHeight = pbStd.Height / 1.75 ' Change it if you like but it works.
'
' If the picture is larger than the page or we want to stretch it then
' scale it to the page
'
If pStretchImage Or lImageWidth > lPrinterWidth Then
lImageWidth = lPrinterWidth
End If
If pStretchImage Or lImageHeight > lPrinterHeight Then
lImageHeight = lPrinterHeight
End If
'
' Calculate the coordinates for the print
'
sX = (lPrinterWidth - lImageWidth) / 2
sY = (lPrinterHeight - lImageHeight) / 2
Printer.PaintPicture pbStd, sX, sY, lImageWidth, lImageHeight
If pEndDoc Then
Printer.EndDoc
End If
On Error GoTo 0
Exit Function
PrinterError:
Err.Raise 10003, "PrintImageFromFile", "Printer error " & _
"(" & Err.Number & " - " & Err.Description & ")"
PrintImageFromFile = 3
InvalidPicture:
Err.Raise 10004, "PrintImageFromFile", pFileName & _
" is not a supported picture format"
PrintImageFromFile = 10004
InvalidFileName:
Err.Raise 10005, "PrintImageFromFile", pFileName & _
" is an invalid file name"
PrintImageFromFile = 10005
End Function
Code: Select all
Private Sub Command1_Click()
cd.CancelError = True
On Error GoTo PrintImageFromFileError
Dim x As Long
Dim sFileToPrint As String
With cd
cd.ShowPrinter
End With
sFileToPrint = "L:\MMPDF\ConsoleFiles\" & Me.txtEST & "\" & "QR.jpg"
Dim lngOption As Long
x = PrintImageFromFile(sFileToPrint, True)
Unload Me
Exit Sub
PrintImageFromFileError:
Select Case Err.Number
Case 32755
'Do Nothing
Case Else
MsgBox "Error " & Err.Number & " - " & _
Err.Description, vbOKOnly, "Error raised"
End
End Select
End Sub
Cheers ...
Dave.
