使用Excel VBA代码将PDF转换为Word文档

xyhw6mcr  于 2023-05-19  发布在  其他
关注(0)|答案(3)|浏览(399)

我需要一个VBA代码来转换Excel数据到PDF到Word文档,我写了一个宏,打印出Excel作为PDF,但现在我想打印出来的Word从PDF,所以短版本,Excel到PDF到Word。所有这一切做我想保持格式的excel数据

xeufq47z

xeufq47z1#

这将执行您想要的操作,但您需要安装Adobe Acrobat。我不知道有什么方法可以在没有安装Acrobat的情况下做到这一点。

Option Explicit
Option Private Module

Sub ClearPaths()

    '------------------------------------------
    'Clears the contains of the sheet Paths.

    'By Christos Samaras
    'Date: 30/03/2013
    'http://www.myengineeringworld.net
    '------------------------------------------

    Dim LastRow As Long

    Application.ScreenUpdating = False

    shPaths.Activate

    'Find the last row.
    With shPaths
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    'Clear the contents of the cells.
    If LastRow > 1 Then
        Range(Cells(2, 1), Cells(LastRow, 2)).Value = ""
        Columns("A:B").EntireColumn.AutoFit
    End If

    shPaths.Range("A2").Select
    Application.ScreenUpdating = True

End Sub

Option Explicit
Option Private Module

Sub ExportAllPDFs()

    '----------------------------------------------------------------
    'Converts all the PDF files that their paths are in column A of
    'the worksheet "Convert PDF Files" into a different file format,
    'based on the value in column B (extension).

    'By Christos Samaras
    'Date: 18/07/2013
    'http://www.myengineeringworld.net
    '----------------------------------------------------------------

    Dim LastRow As Long
    Dim i As Integer

    shPaths.Activate

    'Find the last row.
    With shPaths
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    'Check that there are available file paths.
    If LastRow < 2 Then
        shPaths.Range("A2").Select
        MsgBox "There are no file paths to convert!", vbInformation, "File paths missing"
        Exit Sub
    End If

    'Checking for errors before conversion.
    For i = 2 To LastRow

        'Check if the file extensions are not empty.
        If Cells(i, 2).Value = "" Then
            shPaths.Cells(i, 2).Select
            MsgBox "Please select an output format from the dropdown list!", vbCritical, "File paths missing"
            Exit Sub
        End If

        'Check if the file exists.
        If Dir(shPaths.Cells(i, 1).Value) = "" Then
            shPaths.Cells(i, 1).Select
            MsgBox "The file path is not valid!", vbCritical, "File path error"
            Exit Sub
        End If

        'Check if the input file is a PDF file.
        If LCase(Right(shPaths.Cells(i, 1).Value, 3)) <> "pdf" Then
            shPaths.Cells(i, 1).Select
            MsgBox "The file is not a pdf file!", vbCritical, "No pdf file"
            Exit Sub
        End If

    Next i

    'For each cell in the range "A2:A" & last row convert the pdf file
    'into different format according to the "B2:B" & last row value.
    For i = 2 To LastRow
        SavePDFAs Cells(i, 1).Value, Cells(i, 2).Value
    Next i

    'Adjust the two columns.
    Columns("A:B").EntireColumn.AutoFit

    'Inform the user that conversion finished.
    MsgBox "All files were converted successfully!", vbInformation, "Finished"

End Sub

Private Sub SavePDFAs(PDFPath As String, FileExtension As String)

    '---------------------------------------------------------------------------------------
    'Saves a PDF file as other format using Adobe Professional.

    'In order to use the macro you must enable the Acrobat library from VBA editor:
    'Go to Tools -> References -> Adobe Acrobat xx.0 Type Library, where xx depends
    'on your Acrobat Professional version (i.e. 9.0 or 10.0) you have installed to your PC.

    'Alternatively you can find it Tools -> References -> Browse and check for the path
    'C:\Program Files\Adobe\Acrobat xx.0\Acrobat\acrobat.tlb
    'where xx is your Acrobat version (i.e. 9.0 or 10.0 etc.).

    'By Christos Samaras
    'Date: 30/03/2013
    'http://www.myengineeringworld.net
    '---------------------------------------------------------------------------------------

    Dim objAcroApp      As Acrobat.AcroApp
    Dim objAcroAVDoc    As Acrobat.AcroAVDoc
    Dim objAcroPDDoc    As Acrobat.AcroPDDoc
    Dim objJSO          As Object
    Dim boResult        As Boolean
    Dim ExportFormat    As String
    Dim NewFilePath     As String

    'Initialize Acrobat by creating App object.
    Set objAcroApp = CreateObject("AcroExch.App")

    'Set AVDoc object.
    Set objAcroAVDoc = CreateObject("AcroExch.AVDoc")

    'Open the PDF file.
    boResult = objAcroAVDoc.Open(PDFPath, "")

    'Set the PDDoc object.
    Set objAcroPDDoc = objAcroAVDoc.GetPDDoc

    'Set the JS Object - Java Script Object.
    Set objJSO = objAcroPDDoc.GetJSObject

    'Check the type of conversion.
    Select Case LCase(FileExtension)
        Case "eps": ExportFormat = "com.adobe.acrobat.eps"
        Case "html", "htm": ExportFormat = "com.adobe.acrobat.html"
        Case "jpeg", "jpg", "jpe": ExportFormat = "com.adobe.acrobat.jpeg"
        Case "jpf", "jpx", "jp2", "j2k", "j2c", "jpc": ExportFormat = "com.adobe.acrobat.jp2k"
        Case "docx": ExportFormat = "com.adobe.acrobat.docx"
        Case "doc": ExportFormat = "com.adobe.acrobat.doc"
        Case "png": ExportFormat = "com.adobe.acrobat.png"
        Case "ps": ExportFormat = "com.adobe.acrobat.ps"
        Case "rft": ExportFormat = "com.adobe.acrobat.rft"
        Case "xlsx": ExportFormat = "com.adobe.acrobat.xlsx"
        Case "xls": ExportFormat = "com.adobe.acrobat.spreadsheet"
        Case "txt": ExportFormat = "com.adobe.acrobat.accesstext"
        Case "tiff", "tif": ExportFormat = "com.adobe.acrobat.tiff"
        Case "xml": ExportFormat = "com.adobe.acrobat.xml-1-00"
        Case Else: ExportFormat = "Wrong Input"
    End Select

    'Check if the format is correct and there are no errors.
    If ExportFormat <> "Wrong Input" And Err.Number = 0 Then

        'Format is correct and no errors.

        'Set the path of the new file. Note that Adobe instead of xls uses xml files.
        'That's why here the xls extension changes to xml.
        If LCase(FileExtension) <> "xls" Then
            NewFilePath = WorksheetFunction.Substitute(PDFPath, ".pdf", "." & LCase(FileExtension))
        Else
            NewFilePath = WorksheetFunction.Substitute(PDFPath, ".pdf", ".xml")
        End If

        'Save PDF file to the new format.
        boResult = objJSO.SaveAs(NewFilePath, ExportFormat)

        'Close the PDF file without saving the changes.
        boResult = objAcroAVDoc.Close(True)

        'Close the Acrobat application.
        boResult = objAcroApp.Exit

    Else

        'Something went wrong, so close the PDF file and the application.

        'Close the PDF file without saving the changes.
        boResult = objAcroAVDoc.Close(True)

        'Close the Acrobat application.
        boResult = objAcroApp.Exit

    End If

    'Release the objects.
    Set objAcroPDDoc = Nothing
    Set objAcroAVDoc = Nothing
    Set objAcroApp = Nothing

End Sub

uajslkp6

uajslkp62#

https://www.technipages.com/acrobat-reader-fix-there-was-an-error-opening-this-document-access-denied/#:~:text= An%20error%20may%20appear%20that%20says%20%E2%80%9C%20There,the%20%E2%80%9C%20Enable%20Protected%20Mode%20at%20startup%E2%80%9D%20box.
在Acrobat中,转到菜单->首选项->安全性(增强),取消选中“启动时启用保护模式”,然后单击确定。那么你就不会得到'文件正在使用'错误

svujldwt

svujldwt3#

我使用相同的基本代码,但我总是得到一个错误消息说“错误保存到源文件。它可以在使用中。”我有“Adobe Acrobat PRO DC”。我使用的是“Adobe Acrobat 10.0 Type Library”

Option Explicit

Sub convert_pdf_doc()

Dim aApp As Acrobat.AcroApp
Dim av_doc As Acrobat.AcroAVDoc
Dim pdf_doc As Acrobat.AcroPDDoc
Dim jso_obj As Object

Dim sfile As String 'source file
Dim dfile As String 'destination file
Dim ext As String 'my choise of file

ext = "doc"

sfile = "C:\Temp\Test.pdf"
dfile = Replace(sfile, ".pdf", "." & ext, 1)

Set aApp = CreateObject("AcroExch.App")
Set av_doc = CreateObject("AcroExch.AVDoc")

If av_doc.Open(sfile, vbNull) = True Then

    Set pdf_doc = av_doc.GetPDDoc
    Set jso_obj = pdf_doc.GetJSObject
    
    jso_obj.SaveAs dfile, "com.adobe.acrobat." & ext

End If

av_doc.Close False

aApp.Exit
Set aApp = Nothing
Set av_doc = Nothing

End Sub

相关问题