Recupérer le texte entre accolade [""]

Résolu/Fermé
red12 - 27 juin 2013 à 11:18
 red12 - 27 juin 2013 à 14:36
Bonjour tout le monde,

j'ai un soucis avec une macro que je doit réaliser,alors mon problème c'est que je doit créer une macro qui va récupérer tout ce qui est entre accolade [ xxxx_xxx_xxx] depuis un document word et mettre les données récupérer sur un tableau pour les comparer après.

j'ai réussi a créer la macro mais il marche pas comme je voulu, j'arrive pas a gérer toute les condition parce que dans le document word y a plein de tableaux mais la macro plante a chaque fois .

alors voici le code que j'ai mis besoin de votre aide les amis





' -- Déclaration des variables
Dim wb As Workbook 'classeur Excel dans lequel on importe les données
Dim ws As Worksheet 'onglet Excel dans lequel on importe les données
Dim sChemin As String 'répertoire contenant les fichiers Word
Dim sNomFichier As String 'nom du fichier Word
Dim WApp As Object, WDoc As Object, WSel As Object
Dim i As Integer

' -- Initialisation des variables
Set wb = ThisWorkbook
Set ws = wb.Sheets(2) 'on sauvegarde dans la 1re feuille
sChemin = ChoisirRepertoire & "\" 'fonction pour choisir le répertoire contenant les fichier Word
'sChemin = ThisWorkbook.Path & "\" 'si les fichiers Word se trouvent dans le même répertoire que le fichier Excel
sNomFichier = Dir(sChemin & "*.doc*") 'pour ouvrir tous les fichiers .doc*. 1er fichier.

Set WApp = CreateObject("Word.Application") 'pour créer un objet Word
WApp.Visible = True 'ne pas afficher Word pendant l'exécution
i = ws.Range("A" & Rows.Count).End(xlUp).Row '1re ligne où on va écrire les données dans le fichier Excel


Application.ScreenUpdating = False

' -- Boucle sur les fichiers
Do While Len(sNomFichier) > 0

Set WDoc = WApp.Documents.Open(sChemin & sNomFichier) 'ouvre le document Word
Application.StatusBar = "Écriture ligne " & i 'message dans Excel pour voir la progression

' Nom du fichier
ws.Cells(i, 1) = sNomFichier
ws.Cells(i, 1).Interior.ColorIndex = 6


' No de facture (par la fonction FIND)
WApp.Selection.HomeKey unit:=6 'Retourne au début du fichier Word
WApp.Selection.Find.ClearFormatting 'on "vide la mémoire" de la fonction Recherche

x = 1
Do While x < WApp.ActiveDocument.Paragraphs.Count

WApp.Selection.Find.Execute "["
WApp.Selection.MoveEnd unit:=wdParagraph, Count:=1
Set WSel = WApp.Selection
i = i + 1
ws.Cells(i, 1) = WSel
WApp.Selection.Find.Execute "]"
If WApp.Selection <> "]" Then
WApp.Selection.Find.Execute " "
End If
WApp.Selection.Find.Forward = True
WApp.Selection.Find.Wrap = wdFindContinue
x = x + 1
Loop

i = i + 1 'prochaine ligne
WDoc.Close False 'fermer le document Word sans enregistrer
sNomFichier = Dir 'prochain document
Loop

SortieNormale:
Application.ScreenUpdating = True
WApp.Quit 'Fermer l'instance de Word
Application.StatusBar = False 'Remise à zéro de la barre d'état
With Worksheets("Importaion_des_variables")
With .Range("A1:A3000")
.Replace what:="[", Replacement:="", lookat:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False

End With
End With

merci d'avance

1 réponse

Remplacer ca :
x = 1
Do While x < WApp.ActiveDocument.Paragraphs.Count
WApp.Selection.Find.Execute "["
WApp.Selection.MoveEnd unit:=wdParagraph, Count:=1
Set WSel = WApp.Selection
i = i + 1
ws.Cells(i, 1) = WSel
WApp.Selection.Find.Execute "]"
If WApp.Selection <> "]" Then
WApp.Selection.Find.Execute " "
End If
WApp.Selection.Find.Forward = True
WApp.Selection.Find.Wrap = wdFindContinue
x = x + 1
Loop 


Par ca:


WApp.Selection.HomeKey unit:=wdStory
        Do While Not fin
            With Selection
                With WApp.Selection.Find
                    .Text = "["
                    .Execute
                    .Forward = True
                    fin = .Found = False
                End With
        WApp.Selection.ExtendMode = True
                If Not fin Then
                With WApp.Selection.Find
                        .Text = "]"
                        .Forward = True
                       .Execute
                    End With
                    Set WSel = WApp.Selection
                    i = i + 1
                    ws.Cells(i, 1) = WSel
        WApp.Selection.ExtendMode = False
        WApp.Selection.MoveRight unit:=wdWord, Count:=1
                End If
            End With
        Loop
0