Print Excel cells to image via Excel VBA
Dear Support,
i am looking for an sdk to implement this use case in an excel vba macro:
- do while
- i am filling a range of cells with data from a db
- i do a select of a range of this cells
- at the moment i cut & paste this via a macro and save this to an BMP file
- loop next
the quality of the bmp (or jpg later) is not as good as needed because it depends on screen settings, clear type and some more ...
what i need now is a little vba code to PRINT this cell-range through a virtual printer driver which is saving that file in the loop instead of cut & paste ...
does your software support this ? what will i have to buy ? do you have an example code for me ?
many thanks in advance
================================
Yes, our docPrint Pro v5.0 product has this function, you can download docPrint Pro v5.0 from following web page to try,
https://www.verypdf.com/artprint/index.html#dl
Please refer to following sample VB code, you can use this VB code to draw text, image and graphics to docPrint PDF Driver and save to image file,
==========================================
Private Sub GDIDrawing_Click()
Dim iret As Long, n As Long
Dim s1 As String, xpos As Long, ypos As Long
Dim docinf As DOCINFO
' set up an initial font
Dim log_font As LOGFONT, new_font As Long, old_font As Long
SetOutputFileName_docPrintPDFDriver "C:\output.jpg"
SetDefaultPrinter "docPrint PDF Driver"
If Not GetMyPrinter Then Exit Sub
With log_font
.lfEscapement = 0 ' desired rotation in tenths of a degree
.lfHeight = 12 * (-MyPrinter.dpiY / 72) ' 12 points
.lfFaceName = "Times New Roman" & vbNullChar
.lfWeight = 400 ' standard (bold = 700)
.lfItalic = False
.lfUnderline = False
End With
new_font = CreateFontIndirect(log_font)
old_font = SelectObject(MyPrinter.Handle, new_font)
' start a document
docinf.cbSize = Len(docinf) ' Size of DOCINFO structure
iret = StartDoc(MyPrinter.Handle, docinf) 'Start new document
iret = StartPage(MyPrinter.Handle) 'Start a new page
'
' print a simple line of text at position (1, 1) (inches)
For n = 1 To 10
PrinterText "This is Line " & Format(n), 1, 1 * 0.16 * n
Next n
' end page
iret = EndPage(MyPrinter.Handle) 'End the page
' end the document
SelectObject MyPrinter.Handle, old_font
DeleteObject new_font ' clear up the font
iret = EndDoc(MyPrinter.Handle) 'End the print job
iret = DeleteDC(MyPrinter.Handle)
End Sub
==========================================
The entire test package can be found in following test package,
https://www.verypdf.com/artprint/docPrint-sdk.zip
Above sample code is included in "docPrint-sdk\VB6\demo_converter_com_vb\demo_converter_com.frm" file, after you downloaded it, you can run it and test it easily.
VeryPDF
================================
i exactly KNOW how to select cells with vba, i've sent you that example code line ;-)))
I ONLY NEED THE CODE TO START PRINTING the already select range of cells OR the defined printrange OR the whole sheet to a jpeg file:
for example:
Print2File(active.sheet, outputfilename, JPG)
it should to this file as an JPG file (or selectable other formats), with NO borders, paperformat shoud be the size of the jpeg ...
do you understand ???
==================================
Please refer to following sample code, you can call SetOutputFileName_docPrintPDFDriver() function to set output filename to registry first, then you can call exclApp.Worksheets.PrintOut() function to print Excel document to docPrint PDF Driver printer, please refer to following sample code,
Const sPrinterName = "docPrint PDF Driver"
Sub SaveStringLong(hKey As Long, strPath As String, strValue As String, strData As Long) Dim Ret 'Create a new key RegCreateKey hKey, strPath, Ret 'Set the key's value RegSetValueEx Ret, strValue, 0, REG_DWORD, strData, 4 'close the key RegCloseKey Ret End Sub
Private Sub SetOutputFileName_docPrintPDFDriver(ByVal m_ptrOutputFile As String)
SaveStringLong HKEY_CURRENT_USER, "Software\verypdf\pdfcamp", "AutomaticOutput", 1
SaveStringLong HKEY_CURRENT_USER, "Software\verypdf\pdfcamp", "AutomaticValue", 2
SaveStringLong HKEY_CURRENT_USER, "Software\verypdf\pdfcamp", "AutoView", 0
'SaveStringLong HKEY_CURRENT_USER, "Software\verypdf\pdfcamp", "EmbedNum", 0
SaveStringLong HKEY_CURRENT_USER, "Software\verypdf\pdfcamp", "Unit", 3
SaveStringLong HKEY_CURRENT_USER, "Software\verypdf\pdfcamp", "PageSelect", 10
SaveStringLong HKEY_CURRENT_USER, "Software\verypdf\pdfcamp", "PageSize", 7
SaveStringLong HKEY_CURRENT_USER, "Software\verypdf\pdfcamp", "Bitcount", 1
SaveStringLong HKEY_CURRENT_USER, "Software\verypdf\pdfcamp", "xResolution", 300
SaveStringLong HKEY_CURRENT_USER, "Software\verypdf\pdfcamp", "yResolution", 300
SaveStringLong HKEY_CURRENT_USER, "Software\verypdf\pdfcamp", "PageW", 0
SaveStringLong HKEY_CURRENT_USER, "Software\verypdf\pdfcamp", "PageH", 0
SaveString HKEY_CURRENT_USER, "Software\verypdf\pdfcamp", "AutomaticDirectory", m_ptrOutputFile End Sub
Private Sub PrintXLS_Click()
' You need install MS Excel in order to get this function to work
SetOutputFileName_docPrintPDFDriver "C:\\out.jpg"
On Error GoTo FileOpenDlg_ErrHandler
FileOpenDlg.CancelError = True
FileOpenDlg.Flags = cdlOFNFileMustExist Or cdlOFNPathMustExist Or cdlOFNExplorer Or cdlOFNLongNames
FileOpenDlg.Filter = "MS Excel worksheets (*.xls)|*.xls"
FileOpenDlg.FilterIndex = 1
FileOpenDlg.ShowOpen
On Error Resume Next
Dim exclApp As Object
Dim xlWB As Object
Set exclApp = CreateObject("Excel.Application")
Err = 0
Set xlWB = exclApp.Workbooks.Open(FileOpenDlg.FileName, , True)
If Err = 0 Then
Call exclApp.Worksheets.PrintOut(, , , , sPrinterName)
Call xlWB.Close
Set xlWB = Nothing
End If
Call exclApp.Quit
Set exclApp = Nothing
FileOpenDlg_ErrHandler:
Exit Sub
End Sub
VeryPDF
================================
thank you, that's great ... and quite simple ...
i will do the order in the next hours/day
========================
Thank you for your message, if we can be of any other assistance, please feel free to let us know.
Thank you and have a nice day!
VeryPDF