You need to enable JavaScript to run this app.
最新活动
大模型
产品
解决方案
定价
生态与合作
支持与服务
开发者
了解我们

如何用VBA在Acrobat中查找文本并获取行号,提取PDF整行内容至Excel

解决Acrobat VBA提取指定文本整行内容的问题

嘿,我来帮你搞定这个需求!你现在要做的两件事——查找指定文本并确定行号、提取整行关联内容——核心难点就是处理匹配文本后长度不定的内容,咱们一步步来解决:

1. 先搞定:查找指定文本并识别所在行

Acrobat的VBA对象模型没有直接提供“行号”属性,不过我们可以通过**单词的垂直位置(Y坐标)**来判断是否属于同一行。同一行的单词Y坐标会非常接近,我们可以用这个特征来给页面内的行计数。

2. 核心解决方案:提取匹配文本所在的整行内容

当找到目标文本后,我们需要向前、向后遍历该行的所有单词,直到遇到Y坐标明显变化的单词(也就是下一行/上一行),这样就能收集整行的全部内容了。

完整VBA代码示例

首先确保你已经在VBA编辑器里引用了Adobe Acrobat xx.x Type Library(版本号根据你的Acrobat版本调整):

Sub ExtractPDFLineByTargetText()
    Dim acroApp As Acrobat.CAcroApp
    Dim acroAVDoc As Acrobat.CAcroAVDoc
    Dim acroPDDoc As Acrobat.CAcroPDDoc
    Dim acroPage As Acrobat.CAcroPDPage
    Dim pageNum As Integer, totalPages As Integer
    Dim targetText As String
    Dim wordCount As Integer, i As Integer
    Dim targetWordIndex As Integer, targetY As Double
    Dim lineContent As String
    Dim currentY As Double, lineNumber As Integer
    Dim wordsInLine As Collection
    
    ' 初始化Acrobat对象
    Set acroApp = CreateObject("AcroExch.App")
    Set acroAVDoc = CreateObject("AcroExch.AVDoc")
    Set wordsInLine = New Collection
    
    ' 设置目标文本和PDF路径
    targetText = "Printed By:"
    pdfPath = "C:\YourPDFPath.pdf" ' 替换成你的PDF实际路径
    
    ' 打开PDF文件
    If Not acroAVDoc.Open(pdfPath, "") Then
        MsgBox "无法打开目标PDF文件!"
        GoTo Cleanup
    End If
    Set acroPDDoc = acroAVDoc.GetPDDoc
    totalPages = acroPDDoc.GetNumPages
    
    ' 遍历PDF的每一页
    For pageNum = 0 To totalPages - 1
        Set acroPage = acroPDDoc.AcquirePage(pageNum)
        wordCount = acroPage.GetNumWords
        
        ' 先遍历当前页的所有单词,定位目标文本
        targetWordIndex = -1
        For i = 0 To wordCount - 1
            If LCase(acroPage.GetPageNthWord(i)) = LCase(targetText) Then
                targetWordIndex = i
                ' 获取目标单词的Y坐标(用于判断行归属)
                acroPage.GetPageNthWordRect i, left, top, right, bottom
                targetY = top ' Acrobat的Y坐标从页面顶部开始计算
                Exit For
            End If
        Next i
        
        ' 如果找到目标文本,开始提取整行内容
        If targetWordIndex <> -1 Then
            lineContent = ""
            lineNumber = 1
            Dim prevY As Double
            
            ' 统计目标文本所在的行号(从页面顶部往下数)
            For i = 0 To targetWordIndex
                acroPage.GetPageNthWordRect i, left, top, right, bottom
                currentY = top
                ' 当Y坐标差超过阈值(这里设为5),视为新行
                If i > 0 And Abs(currentY - prevY) > 5 Then
                    lineNumber = lineNumber + 1
                End If
                prevY = currentY
            Next i
            
            ' 收集当前行的所有单词:先向前找行首
            i = targetWordIndex
            Do While i >= 0
                acroPage.GetPageNthWordRect i, left, top, right, bottom
                currentY = top
                If Abs(currentY - targetY) > 5 Then Exit Do
                wordsInLine.Add acroPage.GetPageNthWord(i), Key:=CStr(i)
                i = i - 1
            Loop
            ' 再向后找行尾
            i = targetWordIndex + 1
            Do While i < wordCount
                acroPage.GetPageNthWordRect i, left, top, right, bottom
                currentY = top
                If Abs(currentY - targetY) > 5 Then Exit Do
                wordsInLine.Add acroPage.GetPageNthWord(i), Key:=CStr(i)
                i = i + 1
            Loop
            
            ' 把收集的单词按顺序拼接成整行文本
            For i = wordsInLine.Count To 1 Step -1
                lineContent = lineContent & " " & wordsInLine(i)
            Next i
            lineContent = Trim(lineContent)
            
            ' 将结果输出到Excel(这里默认输出到当前活动工作表)
            With ActiveSheet
                .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = "第" & pageNum + 1 & "页,第" & lineNumber & "行"
                .Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Value = lineContent
            End With
            
            ' 清空集合,准备下一次匹配
            Set wordsInLine = New Collection
        End If
    Next pageNum
    
Cleanup:
    ' 清理Acrobat对象,避免内存占用
    acroAVDoc.Close True
    acroApp.Exit
    Set acroPage = Nothing
    Set acroPDDoc = Nothing
    Set acroAVDoc = Nothing
    Set acroApp = Nothing
    MsgBox "提取完成!"
End Sub

关键代码说明

  • 行号判断:通过对比单词的top坐标,当前后单词的Y坐标差超过设定阈值(这里用5),就视为新行,以此统计目标文本所在的行号。阈值可根据PDF的实际排版调整,行距大的PDF可适当增大数值。
  • 整行内容收集:找到目标单词后,先向前遍历直到行首(Y坐标变化过大),再向后遍历直到行尾,把所有同一行的单词收集起来,最后拼接成完整的行文本,完美适配内容长度不定的情况。
  • 多匹配处理:代码会自动遍历所有页面,提取每一处目标文本所在的整行内容。

内容的提问来源于stack exchange,提问作者arun v

火山引擎 最新活动