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

ho aggiunto PtrSafe (facendo una rapida ricerca su internet, spero corretta) su

Private Declare Function FindExecutable ... che diventa

Private Declare PtrSafe Function FindExecutable ...

perche' il VBA mi diceva

"errore di compilazione

Il codice del progetto deve essere aggiornato per l'utilizzo dei sistemi a

64 bit. Esaminare e aggiornare le istruzioni Declare, quindi

contrassegnarle con l'attributo PtrSafe."

FindExecutable cosa fa ?

cerca l'applicazione predefinita per aprire il file pdf ?

ahi ahi ahi

io suo foxit reader per aprire i pdf, ma per il copia incolla non lavora correttamente e quindi suo acrobat reader 11 SOLO per questo lavoro

ma al momento avendo la priorità ho impostato acrobat come predefinito :-(

Ciao Mauro,

Ho trascurato il fatto che stavi utilizzando le versioni 64-bit di Windows/Excel e, quindi, come hai scoperto, sarà necessario usare PtrSafe. Se dovessi avere bisogno anche di usare il codice su un sistema a 32 bit, potresti utilizzare la compilazione condizionale.

===

Regards,

Norman

Answer 4

ciao Norman

ho usato il trucchetto di copiare il file originario in 

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

poiche'  

myReturn = Shell("C:\Program Files (x86)\Adobe\Acrobat 10.0\Acrobat\AcroRd32.exe " & Name, vbNormalFocus)

mi dava problemi con file e percorsi che contengono spazi 

perche' la tua soluzione invece va benissimo anche con gli spazi ?

ciao

Answer 5

grazie Norman

Application.Wait lo posso sostituire con una istruzione del tipo "premi ok" cioe'

MsgBox "Premi Ok per proseguire"

anche perche' di solito i file pdf in questione sono di 150-200 pagine

quindi il seleziona tutto ci mette da 5 a 10 secondi e il copia da 10 a 30 secondi

ho aggiunto PtrSafe (facendo una rapida ricerca su internet, spero corretta) su

Private Declare Function FindExecutable ... che diventa

Private Declare PtrSafe Function FindExecutable ...

perche' il VBA mi diceva

"errore di compilazione

Il codice del progetto deve essere aggiornato per l'utilizzo dei sistemi a

64 bit. Esaminare e aggiornare le istruzioni Declare, quindi

contrassegnarle con l'attributo PtrSafe."

FindExecutable cosa fa ?

cerca l'applicazione predefinita per aprire il file pdf ?

ahi ahi ahi

io suo foxit reader per aprire i pdf, ma per il copia incolla non lavora correttamente e quindi suo acrobat reader 11 SOLO per questo lavoro

ma al momento avendo la priorità ho impostato acrobat come predefinito :-(

grazie di nuovo

ciao