L.S.,
I get an error when trying to peint a (part) of a sheet (=printarea)
[quote]
C:\Ketel\offertes\2015\TEST\offerte 2015004 naam.pdf
Error trapped by OnError eventhandler.
Error= 438
Description= Property or method not supported by this object object
Source=Offerte_Factuur
Last: 0
Help: 1000438
[/quote]
Settings:
With oPrinterSettings
.SetValue "Output", sFolder & sFileName
.SetValue "ShowSettings", "never"
.SetValue "ShowPDF", "yes"
.SetValue "WriteSettings", "True"
.SetValue "PrintToFile", "true"
.SetValue "ConfirmOverwrite", "no"
.SetValue "ShowProgress", "no"
.SetValue "ShowProgressFinished", "no"
.SetValue "SuppressErrors", "yes"
'.SetValue "EmbedAllFonts", "true"
End With
Debug.Print sFolder & sFileName
Debug.Print ActiveSheet
'Change To PDF printer
sCurrentPrinter = ActivePrinter
'ActivePrinter = sFullPrinterName
'Print the active work sheet
ActiveSheet.PrintOut
The location should be "C:\Ketel\offertes\2015\TEST\" i.e. NOT the Environment data.
The filename could be like "Kopie administratie offerte 2015123 mw Verkerk.pdf"
What is the matter?
Is it not possible to use ordinary Directory names?
Or is the filename maximized?
Looking forward to your help
printing from Excel VBA
Moderator: jr
Re: printing from Excel VBA
This problem has been solved, special Thanks to Jacob
Re: printing from Excel VBA
the code I use now:
[code]
Sub PrintSheet(Optional sFileName As String = "", Optional confirmOverwrite As Boolean = True)
On Error GoTo errhandle
Dim oPrinterSettings As Object
Dim oPrinterUtil As Object
Dim sFolder As String
Dim sCurrentPrinter As String
Dim xmldom As Object
Dim sProgId As String
Dim sPrintername As String
Dim sFullPrinterName As String
'Documentation of the used COM interface Is available at the link below.
'http:www.biopdf.com/guide/dotnet/chm/html/T_bioPDF_PdfWriter_PdfSettings.htm
'Create the objects To control the printer settings.
'Replace biopdf With bullzip If you have the bullzip printer installed instead
'of the biopdf printer.
Set oPrinterSettings = CreateObject(SETTINGS_PROGID)
Set oPrinterUtil = CreateObject(UTIL_PROGID)
'Get the currentprinter.
If Left(Right(ActivePrinter, 5), 2) <> "NE" Then
sFullPrinterName = ActivePrinter
Else
sCurrentPrinter = ActivePrinter
'Get default printer name
sPrintername = oPrinterUtil.DefaultPrinterName
oPrinterSettings.printerName = sPrintername
'Get the full name of the printer
sFullPrinterName = FindPrinter(sPrintername)
End If
If LCase(Right(sFileName, 4)) <> ".pdf" Then
sFileName = sFileName & ".pdf"
End If
'here I'll make a change in order to put the Invoice or the Offer in the correct folder
'temporary solution
If (Mid(sheetName, 1, Len(sheetName) - 4)) = "green" Then
sFolder = "C:\Ketel\offertes\2015\TEST\"
ElseIf (Mid(sheetName, 1, Len(sheetName) - 4)) = "red" Then
sFolder = "C:\Ketel\facturen\2015\TEST\"
End If
'these will not change by sheetname
fileName = sFileName
dirName = sFolder
If sFileName <> "" Then
'make sure that the file name ends with .pdf
If LCase(Right(sFileName, 4)) <> ".pdf" Then
sFileName = sFileName & ".pdf"
End If
End If
'Write the settings to the printer
'Settings are written to the runonce.ini
'This file Is deleted immediately after being used.
Debug.Print sFileName
With oPrinterSettings
.SetValue "Output", sFolder & sFileName
If sFileName = "red.pdf" Then
.SetValue "AppendIfExists", "yes"
.SetValue "MergeFile", sFileName
.SetValue "MergePosition", "Bottom"
Else
.SetValue "appendifexists", "no"
End If
If confirmOverwrite = True Then
.SetValue "ConfirmOverwrite", "no"
Else
.SetValue "ConfirmOverwrite", "yes"
End If
.SetValue "ShowSettings", "never"
.SetValue "ShowPDF", "no"
.SetValue "PrintToFile", "false"
.SetValue "ShowProgress", "no"
.SetValue "ShowProgressFinished", "no"
.SetValue "SuppressErrors", "yes"
.WriteSettings True
End With
'Change To PDF printer
sCurrentPrinter = ActivePrinter
If sCurrentPrinter <> ActivePrinter Then
ActivePrinter = sFullPrinterName
End If
'Print the active work sheet
ActiveSheet.PrintOut _
Copies:=1, _
PrintToFile:=False, _
Collate:=False ',
If ActivePrinter = sCurrentPrinter Then
Exit Sub
Else
'Restore the printer selection
ActivePrinter = sCurrentPrinter
End If
'clean up
Set oPrinterSettings = Nothing
Set oPrinterUtil = Nothing
errhandle:
result = MsgBox("Error trapped by OnError eventhandler." & vbCrLf & "Error= " & Err.Number & vbCrLf & "Description= " & Err.Description & vbCrLf & "Source=" & Err.Source)
'just in case the user couldn't remember the error message, it is printed to the debug.print
Debug.Print ("Error trapped by OnError eventhandler." & vbCrLf & "Error= " & Err.Number & vbCrLf & "Description= " & Err.Description & vbCrLf & "Source=" & Err.Source & "Help context: " & Err.HelpContext)
End Sub
[/code]
[code]
Sub PrintSheet(Optional sFileName As String = "", Optional confirmOverwrite As Boolean = True)
On Error GoTo errhandle
Dim oPrinterSettings As Object
Dim oPrinterUtil As Object
Dim sFolder As String
Dim sCurrentPrinter As String
Dim xmldom As Object
Dim sProgId As String
Dim sPrintername As String
Dim sFullPrinterName As String
'Documentation of the used COM interface Is available at the link below.
'http:www.biopdf.com/guide/dotnet/chm/html/T_bioPDF_PdfWriter_PdfSettings.htm
'Create the objects To control the printer settings.
'Replace biopdf With bullzip If you have the bullzip printer installed instead
'of the biopdf printer.
Set oPrinterSettings = CreateObject(SETTINGS_PROGID)
Set oPrinterUtil = CreateObject(UTIL_PROGID)
'Get the currentprinter.
If Left(Right(ActivePrinter, 5), 2) <> "NE" Then
sFullPrinterName = ActivePrinter
Else
sCurrentPrinter = ActivePrinter
'Get default printer name
sPrintername = oPrinterUtil.DefaultPrinterName
oPrinterSettings.printerName = sPrintername
'Get the full name of the printer
sFullPrinterName = FindPrinter(sPrintername)
End If
If LCase(Right(sFileName, 4)) <> ".pdf" Then
sFileName = sFileName & ".pdf"
End If
'here I'll make a change in order to put the Invoice or the Offer in the correct folder
'temporary solution
If (Mid(sheetName, 1, Len(sheetName) - 4)) = "green" Then
sFolder = "C:\Ketel\offertes\2015\TEST\"
ElseIf (Mid(sheetName, 1, Len(sheetName) - 4)) = "red" Then
sFolder = "C:\Ketel\facturen\2015\TEST\"
End If
'these will not change by sheetname
fileName = sFileName
dirName = sFolder
If sFileName <> "" Then
'make sure that the file name ends with .pdf
If LCase(Right(sFileName, 4)) <> ".pdf" Then
sFileName = sFileName & ".pdf"
End If
End If
'Write the settings to the printer
'Settings are written to the runonce.ini
'This file Is deleted immediately after being used.
Debug.Print sFileName
With oPrinterSettings
.SetValue "Output", sFolder & sFileName
If sFileName = "red.pdf" Then
.SetValue "AppendIfExists", "yes"
.SetValue "MergeFile", sFileName
.SetValue "MergePosition", "Bottom"
Else
.SetValue "appendifexists", "no"
End If
If confirmOverwrite = True Then
.SetValue "ConfirmOverwrite", "no"
Else
.SetValue "ConfirmOverwrite", "yes"
End If
.SetValue "ShowSettings", "never"
.SetValue "ShowPDF", "no"
.SetValue "PrintToFile", "false"
.SetValue "ShowProgress", "no"
.SetValue "ShowProgressFinished", "no"
.SetValue "SuppressErrors", "yes"
.WriteSettings True
End With
'Change To PDF printer
sCurrentPrinter = ActivePrinter
If sCurrentPrinter <> ActivePrinter Then
ActivePrinter = sFullPrinterName
End If
'Print the active work sheet
ActiveSheet.PrintOut _
Copies:=1, _
PrintToFile:=False, _
Collate:=False ',
If ActivePrinter = sCurrentPrinter Then
Exit Sub
Else
'Restore the printer selection
ActivePrinter = sCurrentPrinter
End If
'clean up
Set oPrinterSettings = Nothing
Set oPrinterUtil = Nothing
errhandle:
result = MsgBox("Error trapped by OnError eventhandler." & vbCrLf & "Error= " & Err.Number & vbCrLf & "Description= " & Err.Description & vbCrLf & "Source=" & Err.Source)
'just in case the user couldn't remember the error message, it is printed to the debug.print
Debug.Print ("Error trapped by OnError eventhandler." & vbCrLf & "Error= " & Err.Number & vbCrLf & "Description= " & Err.Description & vbCrLf & "Source=" & Err.Source & "Help context: " & Err.HelpContext)
End Sub
[/code]