|
This Function can convert the ODC/Excel/PPT files into the PDF/TIF/Images.
Private Sub Command1_Click()
'Declartion
' This Function can convert the ODC/Excel/PPT files into the PDF/TIF/Images.
Dim ePrint1 As EPrint
Dim PRINTER_NAME As String
Dim strSourceFileName As String
Dim strDestFileName As String
Dim PrinterSaveOptions As New EpnPrinterSaveOptions
Dim MultiSaveOptions As New EpnMultiSaveOptions
Dim ExtraDcOptions As New EpnExtraDcOptions
Dim hDC As Long
Dim nRet As Integer
'Intializaion
Set ePrint1 = New EPrint
If optDoc.Value = True Then
strSourceFileName = App.Path & "\Testdoc1.doc"
ElseIf optXLS.Value = True Then
strSourceFileName = App.Path & "\testxls1.xls"
ElseIf optPPT.Value = True Then
strSourceFileName = App.Path & "\testppt1.ppt"
End If
PRINTER_NAME = "LEADTOOLS ePrint 5"
'Execution
If ePrint1.IsSupportLocked(LPEPCLib.SupportLockConstants.SUPPORT_EVAL) Then
ePrint1.UnlockSupport LPEPCLib.SupportLockConstants.SUPPORT_EVAL, ""
End If
nRet = ePrint1.GetPrinterSaveOptions(PRINTER_NAME, MultiSaveOptions)
If optPDF.Value = True Then
MultiSaveOptions.PrinterSaveOptions(0).SaveOptions.DocumentOptions.PDFOptions.Factor = 2
strDestFileName = App.Path & "\" & "1001.pdf"
MultiSaveOptions.PrinterSaveOptions(0).SaveOptions.FileName = strDestFileName
MultiSaveOptions.PrinterSaveOptions(0).SaveOptions.DocumentType = FT_SAVE_TYPE_DOCUMENT
MultiSaveOptions.PrinterSaveOptions(0).SaveOptions.Format = FILE_PDF
MultiSaveOptions.PrinterSaveOptions(0).SaveOptions.RasterOptions.BitsPerPixel = 0
MultiSaveOptions.PrinterSaveOptions(0).SaveOptions.RasterOptions.QFactor = 100
MultiSaveOptions.PrinterSaveOptions(0).Flags = 0
MultiSaveOptions.UseSave = True
Set PrinterSaveOptions = MultiSaveOptions.PrinterSaveOptions(0)
nRet = ePrint1.SetPrinterSaveOptions(PRINTER_NAME, MultiSaveOptions)
ElseIf optJPG.Value = True Then
MultiSaveOptions.PrinterSaveOptions(0).SaveOptions.DocumentType = FT_SAVE_TYPE_RASTER
strDestFileName = App.Path & "\" & "2001.jpg"
MultiSaveOptions.PrinterSaveOptions(0).SaveOptions.FileName = strDestFileName
MultiSaveOptions.PrinterSaveOptions(0).SaveOptions.Format = FILE_JPEG
MultiSaveOptions.PrinterSaveOptions(0).SaveOptions.RasterOptions.MultiPageFile = False
MultiSaveOptions.PrinterSaveOptions(0).SaveOptions.RasterOptions.BitsPerPixel = 24
MultiSaveOptions.PrinterSaveOptions(0).SaveOptions.RasterOptions.QFactor = 100
MultiSaveOptions.PrinterSaveOptions(0).Flags = 0
MultiSaveOptions.UseSave = True
Set PrinterSaveOptions = MultiSaveOptions.PrinterSaveOptions(0)
nRet = ePrint1.SetPrinterSaveOptions(PRINTER_NAME, MultiSaveOptions)
ElseIf Opttif.Value = True Then
MultiSaveOptions.PrinterSaveOptions(0).SaveOptions.DocumentType = FT_SAVE_TYPE_RASTER
strDestFileName = App.Path & "\" & "3001.Tif"
MultiSaveOptions.PrinterSaveOptions(0).SaveOptions.FileName = strDestFileName
MultiSaveOptions.PrinterSaveOptions(0).SaveOptions.Format = FILE_TIF
MultiSaveOptions.PrinterSaveOptions(0).SaveOptions.RasterOptions.MultiPageFile = True
MultiSaveOptions.PrinterSaveOptions(0).SaveOptions.RasterOptions.BitsPerPixel = 4
MultiSaveOptions.PrinterSaveOptions(0).SaveOptions.RasterOptions.QFactor = 100
MultiSaveOptions.PrinterSaveOptions(0).Flags = 0
MultiSaveOptions.UseSave = True
Set PrinterSaveOptions = MultiSaveOptions.PrinterSaveOptions(0)
nRet = ePrint1.SetPrinterSaveOptions(PRINTER_NAME, MultiSaveOptions)
End If
hDC = ePrint1.CreateSaveDC(PRINTER_NAME, Nothing, PrinterSaveOptions, ExtraDcOptions)
hDC = 1
If (hDC <> 0) Then
Dim intpageno As Integer
intpageno = 1
ePrint1.StartDocumentConversion PRINTER_NAME, 0
If optDoc.Value = True Then
Dim objWord As Word.Application
Dim objDoc As Word.Document
Set objWord = New Word.Application
objWord.ActivePrinter = "Leadtools eprint 5"
objWord.Documents.Add strSourceFileName
objWord.PrintOut
ePrint1.EndDocumentConversion PRINTER_NAME, 0
objWord.Quit
Set objWord = Nothing
ElseIf optXLS.Value = True Then
Dim MSExcel As Excel.Application
Dim oWS As Excel.Worksheet
Dim intsheetno
intsheetno = 1
Set MSExcel = New Excel.Application
MSExcel.Workbooks.Open strSourceFileName
Set oWS = MSExcel.Worksheets(intsheetno)
MSExcel.Worksheets(intsheetno).Select
MSExcel.ActiveSheet.PrintOut From:=intpageno, To:=intpageno
MSExcel.DisplayAlerts = False
ePrint1.EndDocumentConversion PRINTER_NAME, 0
MSExcel.Quit
Set MSExcel = Nothing
ElseIf optPPT.Value = True Then
Dim MSPPT As PowerPoint.Application
Set MSPPT = New PowerPoint.Application
Dim Pres As PowerPoint.Presentation
Set Pres = MSPPT.Presentations.Open(strSourceFileName, WithWindow:=False)
intpageno = 1
Pres.PrintOut From:=intpageno, To:=intpageno
ePrint1.EndDocumentConversion PRINTER_NAME, 0
MSPPT.Quit
Set MSPPT = Nothing
End If
Else
MsgBox "Creating Save DC failed"
End If
Set ePrint1 = Nothing
Set ExtraDcOptions = Nothing
Set PrinterSaveOptions = Nothing
Set MultiSaveOptions = Nothing
End Sub
|