aprire file pdf, copiare contenuto e incollare il testo in excel

Question

ciao a tutti,

ho creato una macro per copiare il contenuto di un file pdf e incollarlo in un figlio di excel

in realtà la macro non è farina del mio sacco, ma un copia incolla di esperti,

purtroppo devo aver commesso qualche errore

chi riesce a darmi una mano nella correzione ? grazie

mauro

Sub SelezionaPdf()

    Dim myReturn As Double

    Dim sPath, filepdf, filepdf2, cartella, mypath, mycomand As String

    Dim CR, istruz As String

    Dim lRiga, lCol, lng, lUltRiga As Long

    Dim task

    'dichiaro le variabili oggetto di tipo Worksheet e Workbook

    Dim sh As Worksheet

    Dim wk As Workbook

    Dim PageName, PageName2 As String

    CR = "CR3"

    istruz = "istruzioni3"

    Sheets(CR).Select

    cartella = ActiveWorkbook.Name

    Set wk = ThisWorkbook

    Set sh = wk.Worksheets(CR)

     ' these lines look for a pdf file in your My Documents folder

    Set WshShell = CreateObject("WScript.Shell")

    'ChDir (WshShell.SpecialFolders("V:"))

    PageName = Application.GetOpenFilename("YourPage, *.pdf", , "YourPage")

     ' if no file is picked the macro ends

    If PageName = "False" Then

        Exit Sub

    End If

    Sheets(istruz).Range("I1").Value = PageName

    Sheets(CR).Select

    Sheets(CR).Range("A:K").ClearContents

    Range("A1").Select

    PageName2 = "C:\temp\YourPage.pdf"

    FileCopy PageName, PageName2

    mycomand = "C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe C:\temp\YourPage.pdf"

    task = Shell(mycomand, 1)

    Application.Wait (Now + TimeValue("0:00:04"))

    SendKeys "^a", True

    Application.Wait (Now + TimeValue("0:00:02"))

    SendKeys "^c", True

    Application.Wait (Now + TimeValue("0:00:05"))

    'SendKeys ("%fx")

    AppActivate "Microsoft Excel"

    wk.Activate

    sh.Activate

    ' qui sbaglia !!!!!!!!!!!!!!!!!!!!!!!

    Sheets(CR).Select

    Range("A1").Select

    MsgBox "Premi Ok per incollare"

    Sheets(CR).Select

    Range("A1").Select

    SendKeys ("^v")

    ' se togli questa riga, incolla sul foglio sbagliato

    MsgBox "Premi Ok quando incollato"

    Sheets(istruz).Select

    Range("A1").Select

     'Set a Nothing delle variabili oggetto

    Set sh = Nothing

    Set wk = Nothing

End Sub

Answer 1

Ciao Mauro,

Avendo dichiarato la variable sh, sarebbe meglio sarebbe usarla!

'=========>>

Option Explicit

'--------->>

Private Declare Function FindExecutable _

    Lib "shell32.dll" Alias "FindExecutableA" ( _

    ByVal lpFile As String, ByVal lpDirectory As String, _

    ByVal lpResult As String) As Long

'--------->>

Public Sub SelezionaPdf()

    Dim wk As Workbook

    Dim sh As Worksheet

    Dim PageName As Variant, PageName2 As String

    Const CR As String = "CR3"

    Const istruz As String = "istruzioni3"

    Set wk = ThisWorkbook

    Set sh = wk.Worksheets(CR)

    PageName = Application _

               .GetOpenFilename("Text Files (*.pdf), *.pdf")

    If PageName <> False Then

        MsgBox "Open " & PageName

    End If

    If PageName = "False" Then

        Exit Sub

    End If

    Sheets(istruz).Range("I1").Value = PageName

With sh

.Select

.Range("A:K").ClearContents

.Range("A1").Select

End With

    PageName2 = "C:\temp\YourPage.pdf"

    FileCopy PageName, PageName2

    Call OpenPDF(PageName2)

    Application.Wait (Now + TimeValue("0:00:04"))

    SendKeys "^a", True

    Application.Wait (Now + TimeValue("0:00:02"))

    SendKeys "^c", True

    Application.Wait (Now + TimeValue("0:00:05"))

    SendKeys ("%fx")

    AppActivate "Microsoft Excel"

    wk.Activate

    sh.Activate

    MsgBox "Premi Ok per incollare"

    '\ Nuova istruzione

DoEvents

    SendKeys ("^v")

    '\ Nuova istruzione

DoEvents

    Sheets(istruz).Select

    Range("A1").Select

    'Set a Nothing delle variabili oggetto

    Set sh = Nothing

    Set wk = Nothing

End Sub

'--------->>

Sub OpenPDF(filename As String)

    Dim ExeName As String

    Dim N As Long

        ExeName = String(260, 0)

    N = FindExecutable(filename, vbNullString, ExeName)

    ExeName = Left(ExeName, InStr(1, ExeName, vbNullChar) - 1)

    Shell ExeName & " " & Chr(34) & filename & Chr(34), vbNormalFocus

End Sub

'<<=========

===

Regards,

Norman

Answer 2

Ciao Mauro,

Prova la seguente versione del codice:

'=========>>

Option Explicit

'--------->>

Private Declare Function FindExecutable _

    Lib "shell32.dll" Alias "FindExecutableA" ( _

    ByVal lpFile As String, ByVal lpDirectory As String, _

    ByVal lpResult As String) As Long

'--------->>

Public Sub SelezionaPdf()

    Dim wk As Workbook

    Dim sh As Worksheet

    Dim PageName As Variant, PageName2 As String

    Dim Cartella As String

    Const CR As String = "CR3"

    Const istruz As String = "istruzioni3"

    Sheets(CR).Select

    Cartella = ActiveWorkbook.Name

    Set wk = ThisWorkbook

    Set sh = wk.Worksheets(CR)

    PageName = Application _

               .GetOpenFilename("Text Files (*.pdf), *.pdf")

    If PageName <> False Then

        MsgBox "Open " & PageName

    End If

    If PageName = "False" Then

        Exit Sub

    End If

    Sheets(istruz).Range("I1").Value = PageName

    Sheets(CR).Select

    Sheets(CR).Range("A:K").ClearContents

    Range("A1").Select

    PageName2 = "C:\temp\YourPage.pdf"

    FileCopy PageName, PageName2

    Call OpenPDF(PageName2)

    Application.Wait (Now + TimeValue("0:00:04"))

    SendKeys "^a", True

    Application.Wait (Now + TimeValue("0:00:02"))

    SendKeys "^c", True

    Application.Wait (Now + TimeValue("0:00:05"))

    SendKeys ("%fx")

    AppActivate "Microsoft Excel"

    wk.Activate

    sh.Activate

    MsgBox "Premi Ok per incollare"

'\ Nuova istruzione

DoEvents

    SendKeys ("^v")

'\ Nuova istruzione

DoEvents

    Sheets(istruz).Select

    Range("A1").Select

    'Set a Nothing delle variabili oggetto

    Set sh = Nothing

    Set wk = Nothing

End Sub

'--------->>

Sub OpenPDF(filename As String)

    Dim ExeName As String

    Dim N As Long

        ExeName = String(260, 0)

    N = FindExecutable(filename, vbNullString, ExeName)

    ExeName = Left(ExeName, InStr(1, ExeName, vbNullChar) - 1)

    Shell ExeName & " " & Chr(34) & filename & Chr(34), vbNormalFocus

End Sub

'<<=========

Per quanto riguarda il tuo codice, ti farei notare che credo sia consigliabile sempre dichiarare il tipo di tutte le variabili esplicitamente. Per dimostrare il ragionamento di questo consiglio, considera le tue dichiarazioni originali:

    Dim sPath, filepdf, filepdf2, cartella, mypath, mycomand As String

    Dim CR, istruz As String

    Dim lRiga, lCol, lng, lUltRiga As Long

Queste dichiarazioni sarebbero interpretate da VBA come:

    Dim sPath As Variant

    Dim filepdf As Variant, filepdf2 As Variant

    Dim cartella As Variant, mypath As Variant

    Dim mycomand As String

    Dim CR As Variant, istruz As String

    Dim lRiga As Variant, lCol As Variant, lng As Variant, lUltRiga   As Long

mentre la tua intenzione era probabilmente:

    Dim sPath As String

    Dim filepdf As String, filepdf2 As String

    Dim cartella As String, mypath As String

    Dim mycomand As String

    Dim CR As String, istruz As String

    Dim lRiga As Long, lCol As Long, lng As Long, lUltRiga   As Long

===

Regards,

Norman

Answer 3

Ciao Mauro,

Date le eccentricità del metodo SendKeys, è possibile che le tue esigenze possono essere diverse, ma vorrei cancellare le tre istruzioni di Application.OnTime; vorrei anche eliminare le tue istruzioni Activate. Pertanto, prova a sostituire:

    Application.Wait (Now + TimeValue("0:00:04"))

    SendKeys "^a", True

    Application.Wait (Now + TimeValue("0:00:02"))

    SendKeys "^c", True

    Application.Wait (Now + TimeValue("0:00:05"))

    SendKeys ("%fx")

    AppActivate "Microsoft Excel"

    wk.Activate

    sh.Activate

con:

    SendKeys "^a", True

    SendKeys "^c", True

    SendKeys ("%fx")

===

Regards

Norman

Answer 4

ciao Norman

vorrei che i dati venissero copiati sul foglio "CR3"

la macro si trova in "personal.xlsb" (uso excel 2010 a 64 bit su windows 7 a 64 bit )

e lancio la macro dalla barra multifunzione

mentre sono sul foglio "istruzioni3" , qui ridefinito istruz 

sto usando la soluzione sendkey perchè facendo copia-incolla da acrobat mi copia in modo fedele i dati contenuti, mentre usando altre soluzioni (trasformazioni in testo o OCR o pdfToText ) vengono aggiunte righe vuote e caratteri vuoti

ci sono alternative per aprire l'acrebat reader, fare seleziona tutto, copia e poi incollare in excel (o su foglio txt) ?

grazie

mauro27

Answer 5

Ciao Mauro,

Ci sono molti problemi con il codice che hai postato e, per citare un partecipante stimato di questo forum, questo codice "più che di un lifting richiederebbe un rifacimento completo!" Vorrei anche richiamare la tua attenzione sul fatto che l'utilizzo del metodo SendKeys è notoriamente inaffidabile.

Detto questo, e prima di discutere alcuni di questi problemi, quando esegui il codice, sul quale foglio vengono copiati i dati pdf e su quale foglio vuoi che i dati vengano copiati?

===

Regards,

Norman