Crear PDF mediante VBA con BulZip PDF Virtual

Crear un Modulo Clase y . . . . (copiar - pegar este código)

Option Compare Database
Option Explicit

'Need a reference to bzpdfc.dll (Bullzip).
Private mPDFSettings As Bullzip.PDFPrinterSettings
Private mstrCurrentPrinterName As String
Private mstrPDFPrinterName As String
Private Const mintNoPDFPrinter As Integer = 1980
Private Const mintNoCurrentPrinter As Integer = 1981
Public Enum YesNoEnum
End Enum
Public Enum NofileAlwaysNeverEnum
End Enum
Public Enum AlwaysNeverEnum
End Enum
Public Enum YesNoAskEnum
End Enum
Public Enum TargetEnum
End Enum
Public Enum ZoomFitEnum
End Enum
Public Enum TopBottomEnum
End Enum
Public Enum TopBottomCenterEnum
End Enum
Public Enum LeftRightCenterEnum
End Enum
Public Enum KeyLengthEnum
    klLength40 = 40
    klLength128 = 128
End Enum
Public Enum SecuritySettingsEnum
    ssPrintDocument = 4
    ssModifyDocument = 8
    ssCopyDetails = 16
    ssModifyTextAndFillInFields = 32
    ssFillInFields = 256
    ssExtractTextAndGraphics = 512
    ssAssembleDocumentIncBookmarks = 1024
    ssPrintHightQuality = 2048
End Enum
Public Enum NoneAllEnum
End Enum
Public Enum OrientationEnum
End Enum
Public Enum DeviceEnum
End Enum
Public Enum AlphaBitsEnum
    ab1 = 1
    ab2 = 2
    ab4 = 4
End Enum
Public Enum PDFA1BEnum
End Enum
Private Sub Class_Initialize()
    Dim intI As Integer
    Dim intPDFPrinterIndex As Integer
    Dim intCurrentPrinterIndex As Integer
    Set mPDFSettings = New Bullzip.PDFPrinterSettings
    'Printer specific settings
    mstrPDFPrinterName = mPDFSettings.GetPrinterName
    'Find the index of the printer that we want to use
    intPDFPrinterIndex = -1
    intCurrentPrinterIndex = -1
    mstrCurrentPrinterName = Application.Printer.DeviceName
    For intI = 0 To Application.Printers.Count - 1
        If Application.Printers.Item(intI).DeviceName = mstrPDFPrinterName Then
            intPDFPrinterIndex = intI
        End If
        If Application.Printers.Item(intI).DeviceName = mstrCurrentPrinterName Then
            intCurrentPrinterIndex = intI
        End If
    Next intI
    'Exit here if the pdf printer was not found
    If intPDFPrinterIndex = -1 Then
        MsgBox "The printer '" & mstrPDFPrinterName & "' was not found on this computer."
        Err.Raise mintNoPDFPrinter, Err.Source, "Unable to find PDF printer."
    End If
    'Exit here if the current printer was not found
    If intCurrentPrinterIndex = -1 Then
        MsgBox "The current printer '" & mstrCurrentPrinterName & "' was not found on this computer." & _
               " Without this printer the code will not be able to restore the original printer selection."
        Err.Raise mintNoCurrentPrinter, Err.Source, "Unable to find current printer."
    End If
    'Set the printer to the PDF printer.
    Application.Printer = Application.Printers(intPDFPrinterIndex)
End Sub
Private Sub Class_Terminate()
    Dim intI As Integer
    Dim intCurrentPrinterIndex As Integer
    For intI = 0 To Application.Printers.Count - 1
        If Application.Printers.Item(intI).DeviceName = mstrCurrentPrinterName Then
            intCurrentPrinterIndex = intI
        End If
    Next intI
    If intCurrentPrinterIndex = -1 Then
        Err.Raise mintNoCurrentPrinter, Err.Source, "Unable to find original printer to change back to from PDF printer."
        Application.Printer = Application.Printers(intCurrentPrinterIndex)
    End If
    Set mPDFSettings = Nothing
End Sub
Private Function YesNo(YesNoValue As YesNoEnum) As String
    Select Case YesNoValue
    Case YesNoEnum.ynYes
        YesNo = "yes"
    Case YesNoEnum.ynNo
        YesNo = "no"
    End Select
End Function
Private Function NofileAlwaysNever(NofileAlwaysNeverValue As NofileAlwaysNeverEnum) As String
    Select Case NofileAlwaysNeverValue
    Case NofileAlwaysNeverEnum.nanNofile
        NofileAlwaysNever = "noFile"
    Case NofileAlwaysNeverEnum.nanAlways
        NofileAlwaysNever = "always"
    Case NofileAlwaysNeverEnum.nanNever
        NofileAlwaysNever = "never"
    End Select
End Function
Private Function AlwaysNever(AlwaysNeverValue As AlwaysNeverEnum) As String
    Select Case AlwaysNeverValue
    Case AlwaysNeverEnum.anAlways
        AlwaysNever = "always"
    Case AlwaysNeverEnum.anNever
        AlwaysNever = "never"
    End Select
End Function
Private Function YesNoAsk(YesNoAskValue As YesNoAskEnum) As String
    Select Case YesNoAskValue
    Case YesNoAskEnum.ynaYes
        YesNoAsk = "yes"
    Case YesNoAskEnum.ynaNo
        YesNoAsk = "no"
    Case YesNoAskEnum.ynaAsk
        YesNoAsk = "ask"
    End Select
End Function
Private Function TargetFromEnum(TargetValue As TargetEnum) As String
'Case sensitive. Keep in lower case.
    Select Case TargetValue
    Case TargetEnum.tDefault
        TargetFromEnum = "default"
    Case TargetEnum.tEbook
        TargetFromEnum = "ebook"
    Case TargetEnum.tPrepress
        TargetFromEnum = "prepress"
    Case TargetEnum.tPrinter
        TargetFromEnum = "printer"
    Case TargetEnum.tScreen
        TargetFromEnum = "screen"
    End Select
End Function
Private Function ZoomFit(ZoomFitValue As ZoomFitEnum) As String
'Note needed as we have Zoom? TODO
    Select Case ZoomFitValue
    Case ZoomFitEnum.zfFitall
        ZoomFit = "fitall"
    Case ZoomFitEnum.zfFitWidth
        ZoomFit = "fitwidth"
    End Select
End Function
Private Function TopBottom(TopBottomValue As TopBottomEnum) As String
    Select Case TopBottomValue
    Case TopBottomEnum.tbTop
        TopBottom = "top"
    Case TopBottomEnum.tbBottom
        TopBottom = "bottom"
    End Select
End Function
Private Function TopBottomCenter(TopBottomCenterValue As TopBottomCenterEnum) As String
    Select Case TopBottomCenterValue
    Case TopBottomCenterEnum.tbcTop
        TopBottomCenter = "top"
    Case TopBottomCenterEnum.tbcBottom
        TopBottomCenter = "bottom"
    Case TopBottomCenterEnum.tbcCenter
        TopBottomCenter = "center"
    End Select
End Function
Private Function LeftRightCenter(LeftRightCenterValue As LeftRightCenterEnum) As String
    Select Case LeftRightCenterValue
    Case LeftRightCenterEnum.lrcLeft
        LeftRightCenter = "left"
    Case LeftRightCenterEnum.lrcRight
        LeftRightCenter = "right"
    Case LeftRightCenterEnum.lrcCenter
        LeftRightCenter = "center"
    End Select
End Function
Private Function NoneAll(NoneAllValue As NoneAllEnum) As String
    Select Case NoneAllValue
    Case NoneAllEnum.naAll
        NoneAll = "all"
    Case NoneAllEnum.naNone
        NoneAll = "none"
    End Select
End Function
Private Function OrientationFromEnum(OrientationValue As OrientationEnum) As String
    Select Case OrientationValue
    Case OrientationEnum.oPortrait
        OrientationFromEnum = "portrait"
    Case OrientationEnum.oLandscapte
        OrientationFromEnum = "landscape"
    Case OrientationEnum.oSeascape
        OrientationFromEnum = "seascape"
    Case OrientationEnum.oUpsideDown
        OrientationFromEnum = "upsidedown"
    End Select
End Function
Private Function DeviceFromEnum(DeviceValue As DeviceEnum) As String
    Select Case DeviceValue
    Case DeviceEnum.dBMPmono
        DeviceFromEnum = "bmpmono"
    Case DeviceEnum.dBMPGray
        DeviceFromEnum = "bmpgray"
    Case DeviceEnum.dBMPsep1
        DeviceFromEnum = "bmpsep1"
    Case DeviceEnum.dBMPsep8
        DeviceFromEnum = "bmpsep8"
    Case DeviceEnum.dBMP16
        DeviceFromEnum = "bmp16"
    Case DeviceEnum.dBMP256
        DeviceFromEnum = "bmp256"
    Case DeviceEnum.dBMP16m
        DeviceFromEnum = "bmp16m"
    Case DeviceEnum.dBMP32b
        DeviceFromEnum = "bmp32b"
    Case DeviceEnum.dEPSWrite
        DeviceFromEnum = "epswrite"
    Case DeviceEnum.dJPEG
        DeviceFromEnum = "jpeg"
    Case DeviceEnum.dJPEGGray
        DeviceFromEnum = "jpeggray"
    Case DeviceEnum.dPCXMono
        DeviceFromEnum = "pcxmono"
    Case DeviceEnum.dPCXGray
        DeviceFromEnum = "pcxgray"
    Case DeviceEnum.dPCX16
        DeviceFromEnum = "pcx16"
    Case DeviceEnum.dPCX256
        DeviceFromEnum = "pcx256"
    Case DeviceEnum.dPCX24b
        DeviceFromEnum = "pcx24b"
    Case DeviceEnum.dPCXcmyk
        DeviceFromEnum = "pcxcmyk"
    Case DeviceEnum.dPNGMono
        DeviceFromEnum = "pngmono"
    Case DeviceEnum.dPNGGray
        DeviceFromEnum = "pnggray"
    Case DeviceEnum.dPNG16
        DeviceFromEnum = "png16"
    Case DeviceEnum.dPNG256
        DeviceFromEnum = "png256"
    Case DeviceEnum.dPNG16m
        DeviceFromEnum = "png16m"
    Case DeviceEnum.dPNGAlpha
        DeviceFromEnum = "pngalpha"
    Case DeviceEnum.dTIFFGray
        DeviceFromEnum = "tiffgray"
    Case DeviceEnum.dTIFF12nc
        DeviceFromEnum = "tiff12nc"
    Case DeviceEnum.dTIFF24nc
        DeviceFromEnum = "tiff24nc"
    Case DeviceEnum.dTIFF32nc
        DeviceFromEnum = "tiff32nc"
    Case DeviceEnum.dTIFFsep
        DeviceFromEnum = "tiffsep"
    Case DeviceEnum.dTIFFcrle
        DeviceFromEnum = "tiffcrle"
    Case DeviceEnum.dTIFFg3
        DeviceFromEnum = "tiffg3"
    Case DeviceEnum.dTIFFg32d
        DeviceFromEnum = "tiffg32d"
    Case DeviceEnum.dTIFFg4
        DeviceFromEnum = "tiffg4"
    Case DeviceEnum.dTIFFlzw
        DeviceFromEnum = "tifflzw"
    Case DeviceEnum.dTIFFpack
        DeviceFromEnum = "tiffpack"
    Case DeviceEnum.dPDFWrite
        DeviceFromEnum = "pdfwrite"
    End Select
End Function
Private Function PDFA1BFromEnum(PDFA1BValue As PDFA1BEnum)
    Select Case PDFA1BValue
    Case PDFA1BEnum.PDFA1B
        PDFA1BFromEnum = "pdfa1b"
    End Select
End Function
Public Function Output(OutputFilePath As String)
    mPDFSettings.SetValue "Output", OutputFilePath
End Function
Public Function ConfirmOverwrite(YesNoValue As YesNoEnum)
    mPDFSettings.SetValue "ConfirmOverwrite", YesNo(YesNoValue)
End Function
Public Function ShowSaveAS(NofileAlwaysNeverValue As NofileAlwaysNeverEnum)
    mPDFSettings.SetValue "NoFileAlwaysNever", NofileAlwaysNever(NofileAlwaysNeverValue)
End Function
Public Function ShowSettings(AlwaysNeverValue As AlwaysNeverEnum)
    mPDFSettings.SetValue "ShowSettings", AlwaysNever(AlwaysNeverValue)
End Function
Public Function ShowPDF(YesNoAskValue As YesNoAskEnum)
    mPDFSettings.SetValue "ShowPDF", YesNoAsk(YesNoAskValue)
End Function
Public Function Target(TargetValue As TargetEnum)
    mPDFSettings.SetValue "Target", TargetFromEnum(TargetValue)
End Function
Public Function Author(AuthorValue As String)
    mPDFSettings.SetValue "Author", "AuthorValue"
End Function
Public Function UseDefaultAuthor(YesNoValue As YesNoEnum)
    mPDFSettings.SetValue "UseDefaultAuthor", YesNo(YesNoValue)
End Function
Public Function Title(TitleValue As String)
    mPDFSettings.SetValue "Title", TitleValue
End Function
Public Function UseDefaultTitle(YesNoValue As YesNoEnum)
    mPDFSettings.SetValue "UseDefaultTitle", YesNo(YesNoValue)
End Function
Public Function Subject(SubjectValue As String)
    mPDFSettings.SetValue "Subject", SubjectValue
End Function
Public Function Keywords(KeywordsValues As String)
    mPDFSettings.SetValue "Keywords", KeywordsValues
End Function

Public Function Zoom(ZoomFitValue As ZoomFitEnum, Optional ZoomPercent As Byte)
'ZoomPercent of 0 gives no zoom.
    If ZoomFitValue = zfNone Then
        mPDFSettings.SetValue "Zoom", ZoomPercent
        mPDFSettings.SetValue "Zoom", ZoomFit(ZoomFitValue)
    End If
End Function
Public Function UseThumbs(YesNoValue As YesNoEnum)
    mPDFSettings.SetValue "UseThumbs", YesNo(YesNoValue)
End Function
Public Function AutoRotatePages(Optional NoneAllValue As NoneAllEnum = NoneAllEnum.naAll)
    mPDFSettings.SetValue "AutoRotatePages", NoneAll(NoneAllValue)
End Function
Public Function Orientation(OrientationValue As OrientationEnum)
    mPDFSettings.SetValue "Orientation", OrientationFromEnum(OrientationValue)
End Function

Public Function WatermarkText(WatermarkTextValue As String)
    mPDFSettings.SetValue "WatermarkText", WatermarkTextValue
End Function
Public Function WatermarkTransparency(WatermarkTransparencyPercentValue As Byte)
    If WatermarkTransparencyPercentValue > 100 Then
        mPDFSettings.SetValue "WatermarkTransparency", 100
        mPDFSettings.SetValue "WatermarkTransparency", WatermarkTransparencyPercentValue
    End If
End Function
Public Function WatermarkRotation(WatermarkRotationDegreesValue As Integer)
'Currently doesn't accept c2c or -c2c.
    mPDFSettings.SetValue "WatermarkRotation", WatermarkRotationDegreesValue Mod 360
End Function
Public Function WatermarkColor(WatermarkColorHTMLColorValue As String)
'Pass as #RRGGBB
    mPDFSettings.SetValue "WatermarkColor", WatermarkColorHTMLColorValue
End Function
Public Function WatermarkFontName(WatermarkFontNameValue As String)
'Default is arial.ttf
    mPDFSettings.SetValue "WatermarkFontName", WatermarkFontNameValue
End Function
Public Function WatermarkFontSize(WatermarkFontSizeValue As Byte)
    mPDFSettings.SetValue "WatermarkFontSize", WatermarkFontSizeValue
End Function
Public Function WatermarkOutlineWidth(WatermarkOutlineWidthValue As Byte)
'Default is 2.
    mPDFSettings.SetValue "WatermarkOutlineWidth", WatermarkOutlineWidthValue
End Function
Public Function WatermarkLayer(WatermarkLayerValue As TopBottomEnum)
'Default is top.
    mPDFSettings.SetValue "WatermarkLayer", TopBottom(WatermarkLayerValue)
End Function
Public Function WatermarkVerticalPosition(WatermarkVerticalPositionValue As TopBottomCenterEnum)
'Default is center.
    mPDFSettings.SetValue "WatermarkVerticalPosition", TopBottomCenter(WatermarkVerticalPositionValue)
End Function
Public Function WatermarkHorizontalPosition(WatermarkHorizontalPositionValue As LeftRightCenterEnum)
'Default is center.
    mPDFSettings.SetValue "WatermarkHorizontalPosition", LeftRightCenter(WatermarkHorizontalPositionValue)
End Function
Public Function WatermarkVerticalAdjustment(WatermarkVerticalAdjustmentValue As Byte)
'Percentage of page height.
    mPDFSettings.SetValue "WatermarkVerticalAdjustment", WatermarkVerticalAdjustmentValue
End Function
Public Function WatermarkHorizontalAdjustment(WatermarkHorizontalAdjustmentValue As Byte)
'Percentage of page width.
    mPDFSettings.SetValue "WatermarkHorizontalAdjustment", WatermarkHorizontalAdjustmentValue
End Function
Public Function PrinterName()
    PrinterName = mPDFSettings.GetPrinterName
End Function
Public Function ShowProgress(ShowProgressValue As Boolean)
    mPDFSettings.SetValue "ShowProgress", ShowProgressValue
End Function
Public Function ShowProgressFinished(ShowProgressFinishedValue As Boolean)
    mPDFSettings.SetValue "ShowProgressFinished", ShowProgressFinishedValue
End Function

Public Function MergeFiles(MergeIntoFileValue As String)
    mPDFSettings.SetValue "MergeFile", MergeIntoFileValue
End Function
Public Function MergePosition(MergePositionValue As TopBottomEnum)
    mPDFSettings.SetValue "MergePosition", TopBottom(MergePositionValue)
End Function
Public Function Superimpose(SuperimposeOnFileNameValue As String)
    mPDFSettings.SetValue "Superimpose", SuperimposeOnFileNameValue
End Function
Public Function SuperimposeLayer(SuperimposeLayerValue As TopBottomEnum)
    mPDFSettings.SetValue "SuperimposeLayer", TopBottom(SuperimposeLayerValue)
End Function
Public Function SuperimposeResolution(superimposeLayerResolutionDPIValue As Long)
    If superimposeLayerResolutionDPIValue > 14400 Then
        mPDFSettings.SetValue "SuperimposeResolution", 14400
        mPDFSettings.SetValue "SuperimposeResolution", superimposeLayerResolutionDPIValue
    End If
End Function

Public Function OwnerPassword(PasswordValue As String)
    mPDFSettings.SetValue "OwnerPassword", PasswordValue
End Function
Public Function UserPassword(PasswordValue As String)
    mPDFSettings.SetValue "UserPassword", PasswordValue
End Function
Public Function KeyLength(KeyLengthValue As KeyLengthEnum)
    mPDFSettings.SetValue "KeyLength)", KeyLengthValue
End Function
Public Function Permissions(Optional PrintDocument As Boolean = True, _
                            Optional ModifyDocument As Boolean = False, _
                            Optional CopyDetails As Boolean = True, _
                            Optional ModifyTextAndFillInFields As Boolean = False, _
                            Optional FillInFields As Boolean = True, _
                            Optional ExtractTextAndGraphics As Boolean = True, _
                            Optional AssembleDocumentIncBookmarks As Boolean = False, _
                            Optional PrintHighQuality As Boolean = True)
    Dim lngPermissions As Long
    lngPermissions = 61632
    If PrintDocument = True Then
        lngPermissions = lngPermissions + SecuritySettingsEnum.ssPrintDocument
    End If
    If ModifyDocument = True Then
        lngPermissions = lngPermissions + SecuritySettingsEnum.ssModifyDocument
    End If
    If CopyDetails = True Then
        lngPermissions = lngPermissions + SecuritySettingsEnum.ssCopyDetails
    End If
    If ModifyTextAndFillInFields = True Then
        lngPermissions = lngPermissions + SecuritySettingsEnum.ssModifyTextAndFillInFields
    End If
    If FillInFields = True Then
        lngPermissions = lngPermissions + SecuritySettingsEnum.ssFillInFields
    End If
    If ExtractTextAndGraphics = True Then
        lngPermissions = lngPermissions + SecuritySettingsEnum.ssExtractTextAndGraphics
    End If
    If AssembleDocumentIncBookmarks = True Then
        lngPermissions = lngPermissions + SecuritySettingsEnum.ssAssembleDocumentIncBookmarks
    End If
    If PrintHighQuality = True Then
        lngPermissions = lngPermissions + SecuritySettingsEnum.ssPrintHightQuality
    End If
    mPDFSettings.SetValue "Permissions", lngPermissions
End Function
Public Function Device(DeviceValue As DeviceEnum)
    mPDFSettings.SetValue "Device", DeviceFromEnum(DeviceValue)
End Function
Public Function Res(DPIValue As Integer)
    mPDFSettings.SetValue "Res", DPIValue
End Function
Public Function ResX(DPIValue As Integer)
    mPDFSettings.SetValue "ResX", DPIValue
End Function
Public Function RexY(DPIValue As Integer)
    mPDFSettings.SetValue "ResY", DPIValue
End Function
Public Function TextAlphaBits(TextAlphaBitsValue As AlphaBitsEnum)
    mPDFSettings.SetValue "TextAlphaBits", TextAlphaBitsValue
End Function
Public Function GraphicsAlphaBits(GraphicsAlphaBitsValue As AlphaBitsEnum)
    mPDFSettings.SetValue "GraphicsAlphaBits", GraphicsAlphaBitsValue
End Function
Public Function Format(MakePDFA1BCompliantValue As PDFA1BEnum)
    mPDFSettings.SetValue "Format", PDFA1BFromEnum(MakePDFA1BCompliantValue)
End Function
Public Function WriteSettings(TrueOrFalse As Boolean)
    mPDFSettings.WriteSettings TrueOrFalse
End Function

SelectionFile type iconFile nameDescriptionSizeRevisionTimeUser

Descargue El Ejemplo  86 kb v. 1 24 oct. 2011 19:33 Jefferson Jimenez