Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

J

Jérémy26

XLDnaute Nouveau
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
 
Trier par date Trier par votes

p56

XLDnaute Occasionnel
Bonjour,
Sur la base de ce que j'ai déjà proposé précédemment, on peut lister de cette façon :
VB: 
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 ...
 
Vote positif 0 Vote négatif
J

Jérémy26

XLDnaute Nouveau
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
 
Vote positif 0 Vote négatif

p56

XLDnaute Occasionnel
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é).
 
Vote positif 1 Vote négatif
J

Jérémy26

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

Pièces jointes

  • Cahier_test.docx
    101.1 KB · Affichages: 4
Vote positif 0 Vote négatif
J

Jérémy26

XLDnaute Nouveau
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


VB: 
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
 
Dernière édition:
Vote positif 0 Vote négatif
J

Jérémy26

XLDnaute Nouveau
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....
VB: 
    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
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • Résolu(e)
XL 2021 Copie de certaines données Excel sur Word
2
Réponses
28
Affichages
803
Mathos
B
  • Question
XL 2021 Transfert tableau structuré EXCEL à un endroit précis de WORD
Réponses
8
Affichages
821
job75
  • Résolu(e)
XL 2016 VBA - Récupérer le texte d'un fichier PDF
12 13 14
Réponses
200
Affichages
9 K
patricktoulon
S
  • Résolu(e)
Microsoft 365 Récupérer toutes les formules d'un classeur par feuille
Réponses
6
Affichages
531
Sissou71
S
P
  • Question
Microsoft 365 Publipostage avec Excel
Réponses
10
Affichages
404
Sequoyah
J
  • Question
Microsoft 365 Conversion de fichiers word en pdf / VBA
Réponses
1
Affichages
451
kiki29
Y
  • Question
Autres Macros étranges sur ancien fichier Excel
2
Réponses
17
Affichages
549
Oneida
A
  • Résolu(e)
Microsoft 365 incrémenter un tableau à partir d'un TCD
Réponses
6
Affichages
306
auloin
A
  • Résolu(e)
XL 2013 (RESOLU) Automatisation de la Saisie de Données Excel vers un Document Word Modèle
2 3
Réponses
31
Affichages
2 K
job75
C
  • Question
Microsoft 365 Copier des données d'un fichier excel sur un fichier word
Réponses
0
Affichages
908
ChristianJ
C
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…