XL 2016 Macro pour convertir .PDF en .XLSX

[saidoush]

Bonjour,

J'ai tenté de reproduire les instructions d'une video en vu de convertir via une macro un document .pdf en .xlsx.

Chez lui,... ça marche lol

les seules différence c'est que moi j'utilise Foxit et l'adresse du fichier...(forcément)

Merci pour votre aide!!!
et bon dimanche.


Option Explicit

Sub convert_pdf_doc()

Dim foxitApp As Object
Dim av_doc As Object
Dim pdf_doc As Object
Dim jso_obj As Object

Dim sfile As String
Dim dfile As String
Dim ext As String

ext = "xlsx"
sfile = "C:\Users\FAMILLE\Documents\devis dentaire.pdf"
dfile = Replace(sfile, ".pdf", "." & ext, 1)


Set foxitApp = CreateObject("FoxitPDFReader.Application")

Set av_doc = foxitApp.GetActiveDoc()

If Not av_doc Is Nothing Then

Set pdf_doc = av_doc.GetPDDoc()
Set jso_obj = pdf_doc.GetJSObject

jso_obj.SaveAs dfile, "com.foxitpdf.reader." & ext

av_doc.Close

End If

Set foxitApp = Nothing
Set av_doc = Nothing
Set pdf_doc = Nothing
Set jso_obj = Nothing

End Sub

 

[patricktoulon]

re
en effet il considère le saut de ligne tapé dans le word comme un changement de paragraphe

dans le word j'ai reuni des lignes comme paragraphe (menu contextuel /paragraphe)

et excel me sépare bien les paragraphes mais ne capte pas les sauts de ligne

 

[Laurent78]

Bonjour à Tous,
En effet lors de la frappe au km, c'est Word qui effectue seul les changements de ligne. Comme vous, je n'ai pas trouvé comment Word enregistrait ça, c'est même étrange.

Du coup, après de nombreux tests pour compter le nombre de lignes d'un paragraphe, j'ai fait ce bricolage (dans Word, code VBA, dans word, pour faire des essais) :

Sub CompteNombreDeLigne()
DernierCar = ActiveDocument.Paragraphs(5).Range.End 'position du dernier caractère du paragraphe 5
ActiveDocument.Paragraphs(5).Range.Select

Selection.HomeKey Unit:=wdLine, Extend:=wdMove ' on se positionne au début de la première ligne
Selection.EndOf Unit:=wdLine, Extend:=wdMove ' on se positionne à la fin de la première ligne

nbLignes = 1
Do Until Selection.End = DernierCar - 1 'on se déplace de fin de ligne en fin de ligne tant que l'on a pas atteint le dernier caractère du paragraphe
Selection.MoveDown Unit:=wdLine, count:=1, Extend:=wdMove
nbLignes = nbLignes + 1 ' on incrémente le compte de lignes
Loop

MsgBox "Nb de ligne du paragraphe 5 : " & nbLignes

End Sub

C'est une piste ...

Petite astuce pour ceux qui ne connaissent pas :
Pour créer un texte aléatoire dans word vous pouvez utiliser =rand(x, y), x pour le nombre de paragraphes, et y pour le nombre de phrases par paragraphe.

@+

Edit : ci-dessous, en plus simple pour connaitre le nombre de lignes
(le code ci-dessus permet cependant de sélectionner chacune des lignes tour à tour)

    MsgBox ("Le pargraphe 5 comporte " & ActiveDocument.Paragraphs(5).Range.ComputeStatistics(wdStatisticLines) & " Lignes")

 

[Laurent78]

re Bonjour de Forum,
Peut-être une nouvelle piste. Les lignes des paragraphes sont disponibles via la propriété Lines de Rectangle :
Attention, il s'agit d'un code pour VBE word, à adapter pour fonctionner depuis Excel (cf post de Patrick plus bas.

Sub AfficheUneLigneDeParagraphe()
    NoPage = 1
    NoParagraphe = 5
    NoLigne = 4
    MsgBox ActiveWindow.ActivePane.Pages(NoPage).Rectangles(NoParagraphe).Lines(NoLigne).Range.Text
End Sub

re @+

 

[patricktoulon]

re
attention @Laurent78 là c'est un code vba word
a partir d'excel il va falloir le modifier car activewindow.activepane ne veut pas dire la même chose pour excel

 

[patricktoulon]

ceci
devrait fonctionner a partir d'excel

Sub AfficheUneLigneDeParagraphe()
    Dim Wapp As Object, WdoC As Object, para As Object, line
    Dim NoPage&, NoParagraphe&, NoLigne&, win&
    
    NoPage = 1
    NoParagraphe = 8
    NoLigne = 2
    win = 1
    
    Set Wapp = CreateObject("Word.Application")
    Wapp.Visible = False    'facultatif

    ' Ouvrir le document Word
    Set WdoC = Wapp.Documents.Open("C:\Users\patricktoulon\Desktop\word test.docx")

    MsgBox Wapp.Windows(win).ActivePane.Pages(NoPage).Rectangles(NoParagraphe).Lines(NoLigne).Range.Text

    'fermer le document et l'application word
    WdoC.Close False: Wapp.Quit

End Sub

 

[Laurent78]

re
attention @Laurent78 là c'est un code vba word
a partir d'excel il va falloir le modifier car activewindow.activepane ne veut pas dire la même chose pour excel

Hello Patrick,

Oui oui, en effet, j'ai fait tous les tests directement dans Word. Il faut en effet l'adapter pour qu'il puisse fonctionner depuis Excel. Je pensais que j'avais été clair... je vais de ce pas modifier mon post

 

[patricktoulon]

re
tiens pas la peine
voici un modèle qui va de lire dans la consol debug tout les paragraphs ligne par ligne

Sub lire_All_paragraphs_RowByRow()
    Dim Wapp As Object, WdoC As Object, para As Object, line
    Dim NoPage&, NoParagraphe&, NoLigne&, win&, L&, p&

    NoPage = 1
    win = 1

    Set Wapp = CreateObject("Word.Application")
    Wapp.Visible = True    'facultatif

    ' Ouvrir le document Word
    Set WdoC = Wapp.Documents.Open("C:\Users\patricktoulon\Desktop\word test.docx")

    For p = 1 To WdoC.Paragraphs.Count
        Debug.Print "paragraphes (" & p & ")"

        With Wapp.Windows(win).ActivePane.Pages(NoPage).Rectangles(p)
            For L = 1 To .Lines.Count
                Debug.Print "ligne(" & L & ")"

                Debug.Print .Lines(L).Range.Text
            Next
        End With
        Debug.Print "****************************************"
    Next

    'fermer le document et l'application word
    WdoC.Close False: Wapp.Quit

End Sub

 

[patricktoulon]

c'est @laurent950 qui va être content
lire ligne par ligne sans selection

 

[laurent950]

Bonsoir @patricktoulon , @Laurent78

Pour un document Word ont peut partir sur ce type de document Word dont le poste parler de passage de Word vers Excel.

En Poste 1 (il y a le document Word celui avec lequel je fais les test)

XL 2021 - Passage de Word à Excel

Bonjour J'ai un fichier Word d'une facture. Fichier très difficile à remplir ou compléter avec Word. J'aimerais pouvoir le transférer sur Excel et avoir un tableau identique facile à modifier. Je n'ai aucune idée comment le faire Merci d’avance pour votre réponse et bonne journée

excel-downloads.com

' En Mémoire.
' Incompatibilité avec l'objet Range
' Déplacer la sélection à la ligne suivante si ce n'est pas la dernière ligne
wdParagraphe.Range.MoveStart wdLine, 1
cette Object Range ne contient pas pas la classe de "wdLine"
j'ai commencer le code est je bloque sur cette ligne (sur un autres modèle de code : que je te poste ci tu veux ?)

en attendant voici le principe ci-dessous : qui fonctionne sans être en mémoire.

j'ai fait ce code, tu peux tester avec un document Word qui contient du texte (Ligne ou MultiLignes) avec des tableaux.

Comment s'affranchir du document Word et de tous passer en support ? et tous passer en mémoire

Option Explicit
Sub ParcourirParagraphes()
' Déclaration des variables (Boucle)
  Dim wdDoc As Document
  Dim wdParagraphe As Paragraph
    Set wdDoc = ActiveDocument
' Déclaration des variables (Ligne Par Ligne)
  Dim wdNbLignesParagph As Integer
  Dim wdLigneIndex As Byte            ' Index de la ligne dans le paragraphe
  Dim wdtexteLigne As String          ' Texte de la ligne sélectionnée
' Déclaration des variables (Tableau)
  Dim wdTbl As Table
  Dim wdCel As Cell

' Déplacer la sélection au début du document
    Selection.HomeKey wdStory

' Parcourir chaque paragraphe dans le document actif
    For Each wdParagraphe In wdDoc.Paragraphs
        ' Vérifier si le paragraphe n'est pas vide
            If Len(wdParagraphe.Range.Text) > 1 Then
                ' Sélectionner le paragraphe
                    wdParagraphe.Range.Select
                ' Calculer le nombre de lignes dans le paragraphe
                    wdNbLignesParagph = wdParagraphe.Range.ComputeStatistics(wdStatisticLines)
                    ' Test si le Paragraphes est (une ou un ensembles de lignes) OU (Un tableau)
                        If wdParagraphe.Range.Information(wdWithInTable) Then
                            ' Vérifier si la cellule n'est pas dans un tableau
                            If wdParagraphe.Range.Cells.Count > 0 Then
                                'Debug.Print "Ce paragraphe est dans un tableau."
                                'wdParagraphe.Range.Select
                                Set wdTbl = wdParagraphe.Range.Tables.Item(1)
                                Set wdCel = wdParagraphe.Range.Cells(1)
                                ' Vérifier si la cellule est la premiére cellule du tableau
                                   If wdCel.RowIndex = 1 And wdCel.ColumnIndex = 1 Then
                                        wdTbl.Select
                                        Debug.Print wdTbl.Cell(wdCel.RowIndex, wdCel.ColumnIndex).Range.Text
                                   Else
                                        'Debug.Print "La cellule sélectionnée n'est pas la cellule ligne 1 colonne 1"
                                        'Debug.Print "La cellule sélectionnée est la cellule ligne " & wdCel.RowIndex & "  de la colonne " & wdCel.ColumnIndex
                                        wdTbl.Select
                                        Debug.Print wdTbl.Cell(wdCel.RowIndex, wdCel.ColumnIndex).Range.Text
                                  End If
                            End If
                        Else
                            'wdParagraphe.Range.Select
                            'Debug.Print "Ce paragraphe n'est pas dans un tableau."
                            ' Si le paragraphe a une seule ligne
                                If wdNbLignesParagph = 1 Then
                                  ' Déplacer la sélection au début de la ligne
                                    Selection.MoveLeft wdCharacter, 1
                                  ' Étendre la sélection jusqu'à la fin de la ligne et récupérer le texte
                                    Selection.EndKey wdLine, wdExtend
                                    wdtexteLigne = Selection.Text
                                  ' Afficher le texte de la ligne dans la fenêtre de débogage
                                    Debug.Print wdtexteLigne
                                Else
                                  ' Si le paragraphe contient plusieurs lignes
                                  ' Parcourir chaque ligne dans le paragraphe
                                    For wdLigneIndex = 1 To wdNbLignesParagph
                                      ' Sélectionner la ligne
                                      ' Si c'est la première ligne, déplacer la sélection au début de la ligne
                                        If wdLigneIndex = 1 Then
                                            Selection.MoveLeft wdCharacter, 1
                                        End If
                                      ' Étendre la sélection jusqu'à la fin de la ligne
                                        Selection.EndKey wdLine, wdExtend
                                      ' Récupérer le texte de la ligne sélectionnée
                                        wdtexteLigne = Selection.Text
                                      ' Afficher le texte de la ligne dans la fenêtre de débogage
                                        Debug.Print wdtexteLigne
                                      ' Si ce n'est pas la dernière ligne, déplacer la sélection à la ligne suivante
                                        If wdLigneIndex <> wdNbLignesParagph Then
                                            Selection.MoveRight wdCharacter, 1
                                        End If
                                    Next wdLigneIndex
                            End If
                    End If
            End If
    Next wdParagraphe
End Sub

 

[laurent950]

Bonjour le forum, @patricktoulon

J'ai une question @patricktoulon est-ce quand suivant le code qui est en lien en Poste #3 avec Adobe pro (bien sur avec le logiciel)
Et en écrivant tous le code et en connectant les bibliothèques, le code est complet dans cette description (bien sur en recrivant tous le code) tel quel ?

 

[patricktoulon]

re
je pense que oui
maintenant faut il avoir pdf creator pro ou pdf reader DC pro pour l'object (libraie acroesch)

ou bien voir aussi avec edge et firefox étant donné qu'il on un plugins qui permet de faire les modifs de base sur un pdf voir si on peut pas utiliser l'un d'entre eux

bref solution gratos pas cher il y a faut il encore trouver les bon trucs

 

[laurent950]

Ré @patricktoulon

Je vais essayer avec Adobe accrobat pro car j ai cette outils

Je vais écrire le script VBA et essayer. Mais je suis pas très sur que cela va fonctionner.

 

[patricktoulon]

re
va y régale toi

 

[laurent950]

Bonsoir le Forum, @patricktoulon , @Laurent78

Je viens d'écrire le script VBA du Poste #3

Pour Test ci dessous ?

option Explicit
sub convert_pdf_doc
'
  Dim aApp as Acrobat.AcroApp
  Dim av_doc as CAcroAVDoc
  Dim pdf_doc as CAcroPDDoc
  Dim jso_obj as Object
'
  Dim sfile as string
  dim dfile as string
  dim ext as string
'
        ext = "doc" ' Format du fichier créer a enregistré sous ("doc" Ou "xlsx" Ou "html")
'    
        sfile = "D:\Chemin\Fichier.pdf"  ' Ici écrire : Chemin complet + Nom Fichier + Extension
        dfile = Replace(sfile, ".pdf", "." & ext,1)
'
    set aApp = CreateObject("AcroExch.App")
    Set av_doc = CreateObject("AcroExch.AVDoc")
'
        if av_doc.Open(sfile, vbNull) = True then
            set pdf_doc = av_doc.getPDDoc
            set jso_obj = pdf_doc.GetJSObject
       
                jso_obj.SaveAs dfile, "com.adobe.acrobat." & ext
        end if
'
    av_doc.Close false
    aApp.Exit
    Set aApp = Nothing
    set jso_obj = Nothing
    set pdf_doc = Nothing
    set av_doc = Nothing
End Sub

 

[laurent950]

Bonjour le Forum,

Le code en Poste #44 fonctionne très bien en rapport avec le poste #3

Il faut penser à connecter les bibliothèques Adobe Acrobat pro avant d utiliser le code.

Merci.