XL 2019 Récupérer un texte d'un fichier Word

[Jérémy26]

Bonjour, J'ai réalisé une macro VBA sur Excel permettant d'importer tout les tableaux d'un fichier Word et de les traiter.
J'aimerai savoir si c'est possible de pouvoir récupérer un titre d'un document Word pour pouvoir le rajouter dans mon traitement Excel.
Par exemple j'ai un Titre qui commence par "3 " puis un autre part "4 " et j'aimerai savoir quel sont les numéro de tableau qui sont présent entre le titre commençant par "3 "..." et "4..." et en plus récupérer le texte du titre commençant par "3 "... Et ensuite faire la même chose entre le titre commençant par "4 "... jusqu'à la fin de mon document Word (récupéré les numéros des tableaux présent après le titre 4 et récupérer le texte du titre 4.
Si vous pouvez m'aider ou m'orienter sur une piste je suis preneur, si vous avez besoin de plus d'informations n'hésitez pas,
cordialement

 

[p56]

Bonjour,
Sur la base de ce que j'ai déjà proposé précédemment, on peut lister de cette façon :

Dim Prgrf As Object, num As Integer

    Open_Word Word_A_Lire
    With WordDoc
        For Each Prgrf In .Paragraphs
            If Prgrf.Range.Style Like "Titre*" Then
                num = num + 1
                Debug.Print Prgrf.Range.Text & " " & num
            End If
        Next Prgrf
    End With
    Close_Word True

pour rappel : précédemment ...

 

[Jérémy26]

Merci de ta réponse, j'ai un message d'erreur il ne reconnait pas l'objet :
Dim Prgrf As Object

Je ne comprends pas non plus cette ligne de code :
(J'ai remplacé "Titre*" par "3 ")
If Prgrf.Range.Style Like "Titre*" Then

 

[Jérémy26]

Enfaite je veux pouvoir récupérer le texte d'un titre sur word et le rajouter a mon arborescence de tout mes tableaux appartenant à ce titre.

 

[p56]

Heum ... un style n'est pas un contenu ...
Un titre de chapitre peut être "3.Blabla" en style "Titre 1" par exemple.
- pour tester ce titre de chapitre il faut d'abord tester le style (pour le distinguer du corps des chapitres de style "Normal") :
If Prgrf.Range.Style Like "Titre*" Then
- puis son contenu :
If Prgrf.Range.Text Like "3*" Then
etc ...
Maintenant, si vous voulez du code plus précis ce serait bien de poster un exemple de docx (avec des données bidons mais représentatives de la réalité).

 

[Jérémy26]

Heum ... un style n'est pas un contenu ...
Un titre de chapitre peut être "3.Blabla" en style "Titre 1" par exemple.
- pour tester ce titre de chapitre il faut d'abord tester le style (pour le distinguer du corps des chapitres de style "Normal") :
If Prgrf.Range.Style Like "Titre*" Then
- puis son contenu :
If Prgrf.Range.Text Like "3*" Then
etc ...
Maintenant, si vous voulez du code plus précis ce serait bien de poster un exemple de docx (avec des données bidons mais représentatives de la réalité).

Ci joint un exemple type d'un document word pour mieux visualiser ma demande :

 

[Jérémy26]

J'ai dans mes macro une variable arborescence dont je met des données et j'aimerai rajouter dedans le titre dont le tableau appartient.
Ci joint le code pour importer tout les tableaux

Option Explicit
Public Num_tab As Integer

Sub Recup_Tableaux()
Dim i As Integer, j As Integer, k As Integer, lg As Integer, cl As Integer, ligne As Integer, n_col As Integer
Dim S As String, T As Variant, ce As Object, num As String

    Open_Word Word_A_Lire
    ligne = 2
    n_col = 0

    With WordDoc

'----------------------------------------------Liste des tableaux-----------------------------------------
Dim texte As String, pres As Integer, a As String
pres = 2
    For i = 1 To .Tables.Count
        a = 0
'        j = 1
'        k = 2
        
        lg = .Tables(i).Rows.Count
        cl = .Tables(i).Columns.Count
        ReDim T(1 To lg, 1 To cl)
                    
                    
        For j = 1 To lg
            For k = 1 To cl
                S = ""
                If Not Exist_cell(i, j, k) Then
                    num = WordDoc.Tables(i).Cell(j, k).Range.text
                    num = Replace(Replace(num, Chr(7), ""), Chr(13), Chr(10))
                    T(j, k) = num
                    
                    texte = Left(num, 7)
                
                    If texte = "Etape :" Then
                        'MsgBox texte
                        ThisWorkbook.Sheets("Liste_tableaux").Cells(pres, 2) = num
                        a = 1
                    End If
                    
                    If texte = "Objecti" And a = 1 Then
                        'MsgBox texte
                        ThisWorkbook.Sheets("Liste_tableaux").Cells(pres, 3) = num
                    End If
                    
                    If texte = "Scénari" And a = 1 Then
                        'MsgBox texte
                        ThisWorkbook.Sheets("Liste_tableaux").Cells(pres, 1) = i
                        ThisWorkbook.Sheets("Liste_tableaux").Cells(pres, 4) = num
                        pres = pres + 1
                    End If
                End If
            Next k
        Next j
    Next i
    
        Sheets("Liste_tableaux").Select
        Columns("A:D").EntireColumn.AutoFit
        Rows("1:" & i + 1).EntireRow.AutoFit
        
'----------------------------------------------Import tableaux-----------------------------------------


    'Do While ligne <= Sheets("Liste_tableaux").Cells(Rows.Count, 1).End(xlUp).Row


        For ligne = 2 To Sheets("Liste_tableaux").Cells(Rows.Count, 1).End(xlUp).Row
            Num_tab = Sheets("Liste_tableaux").Cells(ligne, 1).Value
            lg = .Tables(Num_tab).Rows.Count
            cl = .Tables(Num_tab).Columns.Count
            ReDim T(1 To lg, 1 To cl)
            For j = 1 To lg
                For k = 1 To cl
                    S = ""
                    If Not Exist_cell(Num_tab, j, k) Then
                        S = WordDoc.Tables(Num_tab).Cell(j, k).Range.text
                        S = Replace(Replace(S, Chr(7), ""), Chr(13), Chr(10))
                        T(j, k) = S
                    End If
                Next k
            Next j

            ThisWorkbook.Sheets("Import").Cells(3, 1 + n_col).Resize(UBound(T, 1), UBound(T, 2)) = T
            
            Sheets("Import").Select
            Range(Cells(2, 1 + n_col), Cells(2, 3 + n_col)).MergeCells = True
            Sheets("Import").Cells(2, 1 + n_col).Select

            Mise_en_forme_tab
            'ligne = ligne + 1
            n_col = n_col + 4

        Next ligne
    'Loop
'---------------------------------------------------------------------------------------------------------

    End With
    'Close_Word
    
        'ferme le document Word sans sauvegarde
    WordDoc.Close False
    
    'ferme l'application Word
    WordApp.Quit
    
End Sub


Function Exist_cell(i As Integer, j As Integer, k As Integer) As Boolean
Dim S As String

    Exist_cell = False
    On Error GoTo errhdlr
    S = WordDoc.Tables(i).Cell(j, k).Range.text
    Exit Function
    
errhdlr:
    Exist_cell = True
End Function

 

[Jérémy26]

J'ai pu réussir à importer tout les titres mais mtn j'ai un problème pour affecter dans mon arborescence de chaque tableau le titre..
Dans mon tableau j'une une case que je compare à un sous titre, si il ont le même texte alors je prendre le grand titre dont le sous titre appartiens, J'ai bien le même texte et le même nombre de caractères, mais ça ne fonctionne pas....

    Dim objPara As Paragraph
    Dim sText As String
    Dim sList As String
    Dim nLevel As Integer
    Dim nLigne As Integer

    nLigne = 2

        For Each objPara In WordDoc.Paragraphs
            With objPara.Range
                If objPara.Style = "Titre 1" Or objPara.Style = "Titre 2" Or objPara.Style = "Titre 3" Or objPara.Style = "Titre 4" Then
                    'MsgBox "Text = " & sText & _
                    "List = " & sList & " Level = " & nLevel

                    sText = .text
                    sList = .ListFormat.ListString
                    nLevel = .ListFormat.ListLevelNumber

                    ThisWorkbook.Sheets("Liste_tableaux").Range("G" & nLigne).Value = nLevel
                    ThisWorkbook.Sheets("Liste_tableaux").Range("H" & nLigne).Value = sText
                    ThisWorkbook.Sheets("Liste_tableaux").Range("I" & nLigne).Value = sList
                    nLigne = nLigne + 1
                End If
            End With
        Next

Ci joint mon code pour importer tout les titres

 

[Jérémy26]

Sinon est t'il possible de récupérer le titre (objPara.Style = "Titre 4") que j'ai avant chaque (WordDoc.Tables(Num_tab)) ????