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

Question

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

acive · Accepted Answer

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

acive · Answer

Bonjour,
J'ai vu CE BOUT DE CODE, j'ai pas testé mais ça pourrait servir...


Cordialement


CF2i - Guadeloupe
Ingénierie Informatique

baub81 · Answer

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

acive · Answer

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

baub81 · Answer

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

acive · Answer

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

baub81 · Answer

Bonjour Acive, 

Ton code m'a beaucoup apporte et surtout soulage mon code :)

cordialement, 
baub81

baub81 · Answer

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 ? :)

baub81 · Answer

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

acive · Answer

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

baub81 · Answer

Merci et merci pour lui :)

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

11 réponses

Votre réponse

Discussions similaires