[VB6 -> VBA]Recuperer une chaine de caractere dans un fichier W à partir de Exce [Résolu]

- - Dernière réponse :  baub81 - 3 mai 2013 à 16:22
Bonjour à tous,

Je débute en VBa, j'ai dejas fait quelques petites macros mais rien d'extraordinaire.

Par contre sur celle ci je bug.

Objectif:
Recuperer des chaines de caractères qui se trouvent entre 2 balises distinctes dans un fichier word depuis une macro excel Vba.

Code actuel:
   'le document Word est supposé fermé avant le lancement de la macro
    Fichier = "D:\Labo\fichier_soft.doc"
    'creation session Word
    Set WordApp =createObject("Word.Application")
    'pour que word reste masqué pendant l'opération
    WordApp.Visible = False
    'ouverture du fichier Word
    Set WordDoc = WordApp.Documents.Open(Fichier)
_____________
_____________
 Txt = "blablablablablabla blablablablablabla [objective] chaineàrecuperer1 chaineàrecuperer2 chaineàrecuperer3 [/[objective]] blablablablablabla blablablablablabla."
    Deb = InStr(1, Txt, "[objective]") + 12
    Fin = InStr(1, Txt, "/objective") + 2
    Tabl = Split(Mid(Txt, Deb, Len(Txt) - Fin), " ")
    'For Each Item In Tabl
     '  MsgBox Item
    'Next Item
    Sheets("Feuil1").Range("A1").Value = Tabl(0)
    Sheets("Feuil1").Range("A2").Value = Tabl(1)
    Sheets("Feuil1").Range("A3").Value = Tabl(2)


Mon fichier word s'ouvre bien en arriere plan et mon code permettant de récupérer une chaîne de caractère aussi.
Le soucis c'est qu'il faudrait parcourir le fichier et l'attribuer à la variable TXT.

Merci d'avance pour votre aide
Afficher la suite 

Votre réponse

11 réponses

Meilleure réponse
3
Merci
Bonjour,
Il y a des exemples sur le site, mais j'ai rien vu qui ressemble à ce que je viens de coder:
Private Sub CommandButton2_Click()
Dim Balise1, Balise1a, Balise2, Balise2a, Balise3, Balise3a As String
Dim Str, St, Result, Liste As String

Str = "[OBJECTIVE] Texte 1 dans objective /OBJECTIVE [REMINDER] Texte dans reminder /REMINDER [TRACE] Texte 1 dans trace /TRACE [OBJECTIVE] Texte 2 dans objective /OBJECTIVE [TRACE] Texte 2 dans trace /TRACE"
Balise1 = "[OBJECTIVE]"
Balise1a = "/OBJECTIVE"
Balise2 = "[REMINDER]"
Balise2a = "/REMINDER"
Balise3 = "[TRACE]"
Balise3a = "/TRACE"

St = Str
Liste = Balise1 & vbCrLf
Do While InStr(1, St, Balise1) > 0
   Result = Split(Split(St, Balise1, 2)(1), Balise1a)(0)
   If Len(Result) > 0 Then Liste = Liste & Result & vbCrLf
    St = Right(St, Len(St) - (InStr(1, St, Balise1)))
Loop
MsgBox Liste

St = Str
Liste = Balise2 & vbCrLf
Do While InStr(1, St, Balise2) > 0
   Result = Split(Split(St, Balise2, 2)(1), Balise2a)(0)
   If Len(Result) > 0 Then Liste = Liste & Result & vbCrLf
   St = Right(St, Len(St) - (InStr(1, St, Balise2)))
Loop
MsgBox Liste

St = Str
Liste = Balise3 & vbCrLf
Do While InStr(1, St, Balise3) > 0
   Result = Split(Split(St, Balise3, 2)(1), Balise3a)(0)
   If Len(Result) > 0 Then Liste = Liste & Result & vbCrLf
   St = Right(St, Len(St) - (InStr(1, St, Balise3)))
Loop
MsgBox Liste

End Sub



Cordialement


CF2i - Guadeloupe
Ingénierie Informatique

Merci Utilisateur anonyme 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources a aidé 97 internautes ce mois-ci

Commenter la réponse de Utilisateur anonyme
0
Merci
Bonjour,
J'ai vu CE BOUT DE CODE, j'ai pas testé mais ça pourrait servir...


Cordialement


CF2i - Guadeloupe
Ingénierie Informatique
Commenter la réponse de Utilisateur anonyme
0
Merci
Merci acive pour ta reponse cela m'a fait avance (un peu)

Bon dapres ce que j'ai pu comprendre cest WordDoc.Fields.result qui peut me donner le contenu de mon texte mais pour le moment sans resultat
Commenter la réponse de baub81
0
Merci
Oui apparemment, tu peux le tester comme ça par exemple:
 For i = 1 To WordDoc.Fields.Count
          If WordDoc.Fields(i).Result <> "" Then
            MsgBox WordDoc.Fields(i).Result.Text
          End If
    Next

Ne pas oublier:
'Nécessite d'activer la référence "Microsoft Word xx.x Object Library"
'(Outils ==> réferences ==> Microsoft Word xx.x Object Library)




Cordialement


CF2i - Guadeloupe
Ingénierie Informatique
Commenter la réponse de Utilisateur anonyme
0
Merci
Bonjour acive,

je comprends pas lorsque je fais

 For i = 1 To WordDoc.Fields.Count
          If WordDoc.Fields(i).Result <> "" Then
            MsgBox WordDoc.Fields(i).Result.Text
          End If
    Next


Et execute ce code, la msgbox me renvoie:
"Test Means" et "" ??

J'ai bien'test means' mais apres plusieurs lignes (cad ligne8 ou 9).

Ci dessous un aperçu de mon fichier. (pas trouve comment le mettre en attachement)

objective:
[OBJECTIVE] ******************************************************************************************************************************** /OBJECTIVE
Covered Objectives:
Blablablablablablablabla
Test configuration and test means:
blablablablablablablablablablablablablablablablablablablablablablablablablablablabla
blablablablablablablabla


Tools used for this procedure:
- Blablablablablablablabla
- Blablablablablablablabla
- Blablablablablablablabla
- blablablablablablablabla
Test sequences:
- [REMINDER] *********************************************************************************************************************************************************************** /REMINDER
- [REMINDER] *********************************************************************************************************************************************************************** /REMINDER
- [TRACE] ************************************ /TRACE
- W************************************t
o [CHECK] C************************************s /CHECK
o [CHECK] C************************************e /CHECK
- [TRACE] S************************************s /TRACE
Commenter la réponse de baub81
0
Merci
Ok...
Une autre méthode:
Copier tout le texte dans une feuille:
Sub Import_Word()
Dim Wrd As Object
NomFich = "c:\users\username\desktop\fichier.doc"
Feuil2.Range("A1") = NomFich

Set Wrd = CreateObject("word.Application")
Wrd.Documents.Open (NomFich)
Wrd.Selection.WholeStory
Wrd.Selection.Copy

ThisWorkbook.Activate
Feuil2.Activate
Feuil2.Range("A2").Select
ActiveSheet.Paste

' Ferme Word en appliquant la méthode Quit sur l'objet Application.
Wrd.Application.Quit
Set Wrd = Nothing
End Sub




Cordialement


CF2i - Guadeloupe
Ingénierie Informatique
Commenter la réponse de Utilisateur anonyme
0
Merci
Bonjour Acive,

Ton code m'a beaucoup apporte et surtout soulage mon code :)

cordialement,
baub81
Commenter la réponse de baub81
0
Merci
Bon en faite mon code se complique de plus en plus... mais maintenant il ne changera plus :)

A l'aide de n type de balise présente plusieurs fois dans un document Word :
(liste des balises: [OBJECTIVE]/OBJECTIVE - [REMINDER]/REMINDER - [TRACE]/TRACE - [CHECK]/CHECK - [LOG]/LOG - [SUBTEST]/SUBTEST )

Je dois récupérer tous les caractères(=mots) dans un fichier Excel avec comme entête de colonne les balises(cad [OBJECTIVE] - [REMINDER] - [TRACE] - [CHECK] - [LOG] - [SUBTEST] )

Un coup de main ? :)
Commenter la réponse de baub81
0
Merci
Merci acive, mais je suis parti sur une autre voie avec laide dun autre developpeur

Sub test()
    Dim Paragraphe As Object, WordApp As Object, WordDoc As Object
    Dim Txt As String, Deb As Integer, Fin As Integer, Ligne As Integer
    Dim Col As Integer, Bal As String
 'le document Word est supposé fermé avant le lancement de la macro
    With Sheets("Feuil1")
        Fichier = "C:\Users\Daniel\Documents\Donnees\Daniel\mpfe\djamat\djamat fichier_soft2.doc"
        'creation session Word
        Set WordApp = CreateObject("Word.Application")
        'pour que word reste masqué pendant l'opération
        WordApp.Visible = False
        'ouverture du fichier Word
        Set WordDoc = WordApp.Documents.Open(Fichier)
        For Each Paragraphe In WordDoc.Paragraphs
            Txt = Paragraphe.Range.Text
            Deb = InStr(1, Txt, "[")
            Fin = InStr(1, Txt, "]")
            If Deb > 0 And Fin > 0 Then
                Bal = Mid(Txt, Deb + 1, Fin - 2)
                If InStr(1, Txt, "& Bal & "") > 0 Then
                    Deb = InStr(1, Txt, "[" & Bal & "]") + Len("[" & Bal & "]")
                    Fin = InStr(1, Txt, "& Bal & "") - Len("& Bal & "")
                    Txt = Mid(Txt, Deb, Fin)
                    Set c = .Rows(1).Find(Bal, , , xlWhole)
                    If c Is Nothing Then
                        If .Cells(1, 1) = "" Then
                            Col = 1
                        Else
                            Col = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
                        End If
                        .Cells(1, Col) = Bal
                    Else
                        Col = c.Column
                    End If
                    .Cells(2, Col) = .Cells(2, Col) & Txt
                End If
            End If
        Next Paragraphe
        WordDoc.Close
        WordApp.Quit
        Set WordDoc = Nothing
        Set WordApp = Nothing
    End With
End Sub

mais si ca peut aider, pour plus tard
Commenter la réponse de baub81
0
Merci
Oui, tout à fait...
C'est ce que je disais, il y en a plein sur le site, tu peux le faire de plusieurs façons, j'ai juste ajouté un bout de code qui pourrait servir à quelqu'un...


Cordialement


CF2i - Guadeloupe
Ingénierie Informatique
Commenter la réponse de Utilisateur anonyme
0
Merci
Merci et merci pour lui :)
Commenter la réponse de baub81

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.