VBA:在pdf的单元格中找到一个单词

时间:2019-01-25 13:39:17

标签: excel vba object pdf

我需要使用pdf pro的api在pdf中查找单元格的值,该api允许我使用它们各自的对象进行编程。

我有一种方法可以使用javascript代码搜索并突出显示pdf中的字符串(可以窃取代码),该问题发生在迭代逻辑中,想要迭代到一个新的单元格,该函数返回到调用并执行的子操作不运行下一行。

Sub charge()
    Dim CONT As Integer
    Dim ARCHI As String
    Dim N As Integer
    Dim J As Range
    CONT = 0
    N = 0
    On Error Resume Next
    'ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Gimnasios"
    J = ThisWorkbook.Sheets("Macro").Range("A2")
    RUTA = "C:\Users\rnovas002\Desktop\Sharepoint\pruebamacroGalicia" 'Modificar ruta
    ChDir RUTA & "\"
    ARCHI = Dir("*.*")
    Do While ARCHI <> ""
        Call hurt(ARCHI, N, J)                   'call function (pointer j)
        If N = 0 Then
            h = "C:\Users\\\\\\" & ARCHI
            Kill h
            N = 0
        End If
        ARCHI = Dir()
    Loop
    MsgBox ("Finalizado")
End Sub

Function hurt(RUTA As String, N As Integer, wordtf3 As Range)
    Dim WshShell As Object
    Dim objAvDoc As New AcroAVDoc
    Dim myApp As Acrobat.AcroApp
    Dim AVDoc As Acrobat.AcroAVDoc
    Dim PDDoc As Acrobat.AcroPDDoc
    Dim PauseTime, Start
    'borrar
    CONTADOR = ThisWorkbook.Sheets("Macro").Application.WorksheetFunction.CountA(Range("A:A")) - 1
    wordtf = "PLAZO"                             '//word to find
    wordTF2 = "FIJO"

    pdfText = ""
    '// get the active Document
    If (objAvDoc.Open("C:\Users\rnovas002\Desktop\Sharepoint\pruebamacroGalicia\" & RUTA, "")) Then
        objAvDoc.BringToFront
        Set AcroApp = CreateObject("AcroExch.App")
        Set AVDoc = AcroApp.GetActiveDoc
        Set PDDoc = AVDoc.GetPDDoc
        Set aform = CreateObject("AFormAut.App") 'connect to Form API for later use
        Set jso = PDDoc.GetJSObject

        maxPages = PDDoc.GetNumPages
        N = 0
        For p = 0 To maxPages - 1                '// start the page loop
            Set PdfPage = PDDoc.AcquirePage(p)   '// p  = Pagenumber (zero based)
            Set PageHL = CreateObject("AcroExch.HiliteList") '// created to get the page text
            PageHLRes = PageHL.Add(0, 9000)      '<<--SET in FILE! (Start,END[9000=All])
            Set PageSel = PdfPage.CreatePageHilite(PageHL)

            'this is the line with te problem
            For R = 0 To CONTADOR                'this is the iteration of the cells
                '-----------------

                For i = 0 To PageSel.GetNumText - 1 '// start the word loop on current page

                    WORD = PageSel.GetText(i)    '// get one word
                    pdfText = pdfText & WORD     '// gather words on page

                    If InStr(UCase(WORD), UCase(wordtf)) Or InStr(UCase(WORD), UCase(wordTF2)) Or InStr(UCase(WORD), UCase(wordtf3)) Then '// used instr because the "word" you may get as "word 'EL UCASE LA PASA A MAYUSCULA PORQUE EL INSTR ES CASE SENSITIVE
                        Set wordToHl = CreateObject("AcroExch.HiliteList") '// created to get the word on list
                        wordToHl.Add i, 1        'Hilite the word Reinhard
                        Set wordHl = PdfPage.CreateWordHilite(wordToHl)
                        AVDoc.SetTextSelection (wordHl) '// highlight the word (not really needed)
                        AVDoc.ShowTextSelect

                        Set rect = wordHl.GetBoundingRect
                        '  MsgBox ("left:" & rect.Left & " bot:" & rect.bottom & " right:" & rect.Right & " top:" & rect.Top)
                        '// show highlighted text (not really needed)
                        '// write and execute js to mark permanent (to lazy to translate to jso)
                        ex = " // set annot for text selection " & vbLf _
                           & "var sqannot = this.addAnnot({type: ""Square"", page: " & p & ", " & vbLf _
                                                                                           & "rect: [" & rect.Left & ", " & rect.Top & ", " & rect.Right & ", " & rect.bottom & "], " & vbLf _
                                                                                           & "name: ""p" & p & "i" & i & """});"
                        'MsgBox (ex)
                        aform.Fields.executethisjavascript ex
                        N = N + 1
                    End If                       '// word found
                    If InStr(UCase(WORD), UCase(wordtf3)) Then
                        GoTo ETIQUETA
                    End If
                Next                             '// get next word

                'SET NEW VALUE OF CELL
                'AT THIS POINT THE FUNCTION STOP TO EXECUTE AND RETURNS TO THE SUB
                Set wordtf3 = wordtf3.Offset(1, 0)
            Next R
            'MsgBox (pdfText)
            pdfText = ""
        Next                                     '// get next page

    End If
ETIQUETA:
    SendKeys ("^(s)")
    Application.Wait (Now + TimeValue("00:00:02"))
    objAvDoc.Close 0
End Function

'-----------------------------

0 个答案:

没有答案