Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 70580 Skopiuj do schowka Adobe Excel czeka na OLE Adobe
Autor Wiadomość
Auditorius 
Exceloholic


Wersja: Win Office 2013
Pomógł: 1 raz
Posty: 216
Wysłany: 05-04-2021, 11:33   Adobe Excel czeka na OLE Adobe

Dzień Dobry,

Mam funkcję do wyszukiwania słów w PDFach z pomoca pełnej wersji Acrobata
Kod:

Option Explicit


Function Znajdz1słowowPDFie(PDF_Path As String, Word_To_Find As String) As String
     
    '----------------------------------------------------------------------------------------
    'This macro can be used to find a specific WORD in a PDF document (one word ONLY -> in
    'case you search two words for example it doesn't find anything, just opens the file).
    'The macro opens the PDF, finds the first appearance of the specified word, scrolls
    'so that it is visible and highlights it.

    'The code uses late binding, so no reference to external library is required.
    'However, the code works ONLY with Adobe Professional, so don't try to use it with
    'Adobe Reader because you will get an "ActiveX component can't create object" error.
   
    'Written by:    Christos Samaras
    'Date:          04/05/2014
    'e-mail:        'xristos.samaras@gmail.com'
    'site:          'http://www.myengineeringworld.net'
    ' Change into Function Auditorius 2021
    '--------------------------------------------------------------------------------------

' Speed On
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Application.Calculation = xlAutomatic
ThisWorkbook.Date1904 = False
ActiveWindow.View = xlNormalView
   
    'Declaring the necessary variables.
    Dim App         As Object
    Dim AVDoc       As Object
    Dim PDDoc       As Object
    Dim JSO         As Object
    Dim i           As Long
    Dim j           As Long
    Dim Word        As Variant
    Dim Result      As Integer

    'Specify the text you want to search.
    'Word_To_Find = "Engineering"
    'Using a range:
    'Word_To_Find = ThisWorkbook.Sheets("PDF Search").Range("C12").Value
   
    'Specify the path of the sample PDF form.
    'Full path example:
    'PDF_Path = "C:\Users\Christos\Desktop\How Software Companies Die.pdf"
    'Using workbook path:
    'PDF_Path = ThisWorkbook.Path & "\" & "How Software Companies Die.pdf"
    'Using a range:
    'PDF_Path = ThisWorkbook.Sheets("PDF Search").Range("C14").Value
   
    'Check if the file exists.
    If Dir(PDF_Path) = "" Then
    Znajdz1słowowPDFie = "Nie mogę odnaleźć pliku PDF! Sprawdź ścieżkę pliku i spróbuj ponownie"
    Exit Function
    End If
   
    'Check if the input file is a PDF file.
    If LCase(Right(PDF_Path, 3)) <> "pdf" Then
    Znajdz1słowowPDFie = "Plik wejściowy to nie plik PDF !"
    Exit Function
    End If
   
    'Initialize Acrobat by creating the App object.
    Set App = CreateObject("AcroExch.App")
   
    'Check if the object was created. In case of error release the objects and exit.
    If err.Number <> 0 Then
    Znajdz1słowowPDFie = "Nie moge utworzyć obiektu Adobe Application!"
        Set App = Nothing
        Exit Function
    End If
   
    'Create the AVDoc object.
    Set AVDoc = CreateObject("AcroExch.AVDoc")
   
    'Check if the object was created. In case of error release the objects and exit.
    If err.Number <> 0 Then
    Znajdz1słowowPDFie = "Nie moge utworzyć obiektu AVDoc"
        Set AVDoc = Nothing
        Set App = Nothing
    Exit Function
    End If
   
   
    'Open the PDF file.
   
    'If AVDoc.Open(PDF_Path, "") <> True Then
    '     Znajdz1słowowPDFie = "Nie moge otworzyć pliku PDF !"
    '    Set AVDoc = Nothing
    '    Set App = Nothing
    'Exit Function
    'End If
   
   
        If AVDoc.Open(PDF_Path, "") = True Then
       
        'Open successful, bring the PDF document to the front.
    '    AVDoc.BringToFront
       
        'Set the PDDoc object.
        Set PDDoc = AVDoc.GetPDDoc
       
        'Set the JS Object - Java Script Object.
        Set JSO = PDDoc.GetJSObject
       
       
       
        'Search for the word.
        If Not JSO Is Nothing Then
       
            'Loop through all the pages of the PDF.
            For i = 0 To JSO.numPages - 1
           
                'Loop through all the words of each page.
                For j = 0 To JSO.getPageNumWords(i) - 1
                   
                    'Get a single word.
                    Word = JSO.getPageNthWord(i, j)
                   
                    'If the word is string...
                    If VarType(Word) = vbString Then
                       
                        'Compare the word with the text to be found.
                        Result = StrComp(Word, Word_To_Find, vbTextCompare)
                       
                        'If both strings are the same.
                        If Result = 0 Then
                            'Select the word and exit.
                            Znajdz1słowowPDFie = "Znalazłem szukane 1 słowo !"
'                            Call JSO.selectPageNthWord(i, j)
                            Exit Function
                        End If
                       
                    End If
                   
                Next j
               
            Next i
           
            'Word was not found, close the PDF file without saving the changes.
            AVDoc.Close True
           
            'Close the Acrobat application.
            App.Exit
               
            'Release the objects.
            Set JSO = Nothing
            Set PDDoc = Nothing
            Set AVDoc = Nothing
            Set App = Nothing
           
            'Inform the user.
            Znajdz1słowowPDFie = "Słowa '" & Word_To_Find & "' nie ma w pliku PDF!"
        Exit Function
        End If
       
    Else
               
        'Unable to open the PDF file, close the Acrobat application.
        App.Exit

        'Release the objects.
        Set AVDoc = Nothing
        Set App = Nothing
       
        'Inform the user.
        Znajdz1słowowPDFie = "Nie mogę otworzyć pliku PDF!"
        Exit Function
    End If
   
' Speed OFF
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic
ThisWorkbook.Date1904 = False
Application.StatusBar = False
   
End Function



Mam też kod od obsługi sytuacji 'Excel czeka na zakończenie działania OLE"
W moim przypadku chodzi o sytuację kiedy pliki PDF jest uszkodzony i nie da się go otworzyć w Adobe. W takim przypadku chciałbym albo:
- wygenerować wartość funkcji jako 'błąd w pliku PDF" i zakończyć
- albo kliknąć 'OK"

Znalazłem taki kod
Kod:

Private Declare Function CoRegisterMessageFilter Lib "ole32" (ByVal IFilterIn As Long, ByRef PreviousFilter) As Long

Public Sub KillMessageFilter()

   Dim IMsgFilter As Long

   CoRegisterMessageFilter 0&, IMsgFilter

End Sub



I analogiczny kawałek
Kod:

 https://groups.google.com/g/microsoft.public.excel.programming/c/ct8NRT-o7rs/m/jawi42S8Ci0J?pli=1
'You can solve this by using the COM API to remove VBA's message filter.
'This will prevent COM from telling VBA to displaying a message box when it
'thinks the process you're calling has blocked. Note that if the process
'really has blocked for some reason this will prevent you from receiving any
'notification of that.

Private Declare Function _
CoRegisterMessageFilter Lib "OLE32.DLL" _
(ByVal lFilterIn As Long, _
ByRef lPreviousFilter) As Long

Function KillMessageFilter()

Dim lMsgFilter As Long

' Remove the message filter before calling Reflections.
CoRegisterMessageFilter 0&, lMsgFilter

''' Call Reflections here....

''' Restore the message filter after calling Reflections.
' I am calling it off
CoRegisterMessageFilter lMsgFilter, lMsgFilter

End Function

'Rob Bovey, MCSE, MCSD, Excel MVP
'Application Professionals
'http://www.appspro.com/




Ale nie wiem jak go połączyć z funkcją wyszukiwania słowa w Adobe - jak 'zagniezdzam' jedną funkcję w drugiej to non stop wyskakują różne błedy.
Analogicznie jak 2gą funkcję przesunąlem 'na koniec' i probuję wywołać to Call
to występują inne błędy


Czy da się 'po prostu' kliknąć guzik OK ?
_________________
Nobody's Perfect
  
ID posta: 403184 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe