pdf按需求拆分转长图

衣征尘

excel表三列，一列起始页码，一列终止页码，一列文件名，将所要拆分的pdf文件按这第一第二列页码的要求，拆分转成长图，按第三列命名

如果能自动获取pdf文件的目录及对应页码就更好了。

vba可以，python等请弄成可单独运行的。

币不够可加。

fxzh007

[Lua] 纯文本查看 复制代码

Sub SplitPDFs()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long

    ' 打开工作表
    Set ws = ThisWorkbook.Sheets("Sheet1") ' 修改为你的工作表名称

    ' 获取最后一行
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' 循环处理每一行
    For i = 2 To lastRow ' 假设数据从第二行开始，第一行为标题
        Dim startPage As Integer
        Dim endPage As Integer
        Dim filename As String

        ' 从工作表中获取数据
        startPage = ws.Cells(i, 1).Value
        endPage = ws.Cells(i, 2).Value
        filename = ws.Cells(i, 3).Value

        ' 拆分PDF
        If Not SplitPDF(startPage, endPage, filename, i) Then
            MsgBox "Failed to split PDF at row " & i, vbExclamation
            Exit Sub ' 如果拆分失败，退出子程序
        End If
    Next i

    MsgBox "PDFs have been split successfully!", vbInformation
End Sub

Function SplitPDF(startPage As Integer, endPage As Integer, filename As String, rowIndex As Integer) As Boolean
    Dim objPDF As Object
    Dim objPages As Object
    Dim i As Integer
    Dim outputPath As String

    On Error GoTo ErrorHandler ' 添加错误处理

    ' 创建 PDF 应用对象
    Set objPDF = CreateObject("AcroExch.PDDoc")

    ' 打开 PDF 文件
    If objPDF.Open("C:\Path\To\Your\PDF\File.pdf") Then ' 修改为你的PDF文件路径
        ' 创建输出文件夹
        outputPath = "C:\Path\To\Output\Folder\" ' 修改为你的输出文件夹路径
        If Not FolderExists(outputPath) Then
            MkDir outputPath
        End If

        ' 循环处理每一页
        For i = startPage To endPage
            ' 创建页面对象
            Set objPages = CreateObject("AcroExch.PDPage")

            ' 复制页面到新文件
            objPDF.AcquirePage i - 1
            objPDF.CopyPagesTo i - 1, i - 1, objPages, 1

            ' 保存页面为图片
            objPages.SaveAsJPEG outputPath & filename & "_" & i & ".jpg", 300, 300, 0

            ' 释放对象
            Set objPages = Nothing
        Next i

        ' 关闭 PDF 文件
        objPDF.Close
        SplitPDF = True ' 拆分成功
    Else
        SplitPDF = False ' 拆分失败
    End If

    Exit Function ' 正常退出函数

ErrorHandler:
    MsgBox "Error: " & Err.Description & " at row " & rowIndex, vbCritical ' 显示错误消息
    SplitPDF = False ' 拆分失败
End Function

Function FolderExists(ByVal folderPath As String) As Boolean
    If Dir(folderPath, vbDirectory) <> "" Then
        FolderExists = True
    Else
        FolderExists = False
    End If
End Function

我在 SplitPDFs 主程序中传递了行索引，以便在出错时能够显示是哪一行出现了问题
你再看看具体是哪一部分出错了

fxzh007

[Lua] 纯文本查看 复制代码

Sub SplitPDFs()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long

    ' 打开工作表
    Set ws = ThisWorkbook.Sheets("Sheet1") ' 修改为你的工作表名称

    ' 获取最后一行
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' 循环处理每一行
    For i = 2 To lastRow ' 假设数据从第二行开始，第一行为标题
        Dim startPage As Integer
        Dim endPage As Integer
        Dim filename As String

        ' 从工作表中获取数据
        startPage = ws.Cells(i, 1).Value
        endPage = ws.Cells(i, 2).Value
        filename = ws.Cells(i, 3).Value

        ' 拆分PDF
        Call SplitPDF(startPage, endPage, filename)
    Next i

    MsgBox "PDFs have been split successfully!", vbInformation
End Sub

Sub SplitPDF(startPage As Integer, endPage As Integer, filename As String)
    Dim objPDF As Object
    Dim objPages As Object
    Dim i As Integer
    Dim outputPath As String

    ' 创建 PDF 应用对象
    Set objPDF = CreateObject("AcroExch.PDDoc")

    ' 打开 PDF 文件
    If objPDF.Open("C:\Path\To\Your\PDF\File.pdf") Then ' 修改为你的PDF文件路径
        ' 创建输出文件夹
        outputPath = "C:\Path\To\Output\Folder\" ' 修改为你的输出文件夹路径
        MkDir outputPath

        ' 循环处理每一页
        For i = startPage To endPage
            ' 创建页面对象
            Set objPages = CreateObject("AcroExch.PDPage")

            ' 复制页面到新文件
            objPDF.AcquirePage i - 1
            objPDF.CopyPagesTo i - 1, i - 1, objPages, 1

            ' 保存页面为图片
            objPages.SaveAsJPEG outputPath & filename & "_" & i & ".jpg", 300, 300, 0

            ' 释放对象
            Set objPages = Nothing
        Next i

        ' 关闭 PDF 文件
        objPDF.Close
    End If

    ' 释放对象
    Set objPDF = Nothing
End Sub

试试看行不行

衣征尘

wps运行时错误429：activex 部件不能创建对象

Set objPDF = CreateObject("AcroExch.PDDoc")

衣征尘

fxzh007 发表于 2024-6-7 12:18
[mw_shl_code=lua,true]Sub SplitPDFs()
    Dim ws As Worksheet
    Dim lastRow As Long

错误429是因为wps的原因还是需要安装什么插件？

fxzh007

错误 429 通常表示某个 ActiveX 组件或对象在系统中找不到或无法创建。
你需要安装Adobe Acrobat

衣征尘

fxzh007 发表于 2024-6-7 14:37
错误 429 通常表示某个 ActiveX 组件或对象在系统中找不到或无法创建。
你需要安装Adobe Acrobat

在论坛里搜，百度的都过期了，天翼的下载不来

fxzh007

安装Adobe Reader软件也行

衣征尘

fxzh007 发表于 2024-6-7 14:44
安装Adobe Reader软件也行

您稍等等，我先再找找Adobe Acrobat，我看有说Adobe Reader不行的

abcttud

vba的能分享下吗？看看什么效果