Discussion :

[djamat]

Bonjour à tous,

Je suis debutant en VB et grace à l'aide d'un des membres, on a reussi à recuperer un texte entre balise d'un ficheir word pour le mettre dans un fichier Excel.

Maintenant le probleme est que lorsque je recupere ces chaines de caracteres, il me faudrait les faire correspondre avec ma balise "objective" cad fusionner les cellules de la chaine de caractere 'objective' selon le nombre de lignes affichées apres avant de passer à un autre 'objective'.

En pièce jointe vous trouverez, un .xls montrant le résultat souhaitait et un .doc montrant comment est constitué le fichier de depart.

Merci pour votre aide, si je n'ai pas été assez claire merci de me le dire

[djamat]

avec du code ce serait mieux

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
For Each Paragraphe In WordDoc.Paragraphs
         'pour chaque paragraphe on verifie si il y a un [ et un ]
         Txt = Paragraphe.Range.Text
         Deb = InStr(1, Txt, "[")
         Fin = InStr(1, Txt, "]")
 
         'deb & fin seront toujours superieur à 0 si txt a un [ ou ]
         If Deb > 0 And Fin > 0 Then
            'bal recupere le nom de la balise, +1 pour le [ et -2 pour /], donc bal=objective par exemple
            Bal = Mid(Txt, Deb + 1, Fin - 2)
 
            'vérification de la présence d'une balise de fin
            If InStr(1, Txt, "[/" & Bal & "]") > 0 Then
            'deb: calcule le nombre de caractere selon la balise cad "[REMINDER] "=10+1espace
            'fin: compte le nombre de caractere avant la balise avant [/
            'txt: recupere le resultat à afficher
               Deb = InStr(1, Txt, "[" & Bal & "]") + Len("[" & Bal & "]")
               Fin = InStr(1, Txt, "[/" & Bal & "]") - Len("[/" & Bal & "]")
               Txt = Mid(Txt, Deb, Fin)
               'entete de colonne cad bal
               Set c = .Rows(1).Find(Bal, , , xlWhole)
 
               If c Is Nothing Then
               'si la cellule A1 est vide alors colonne prends 1 sinon elle s'incremente;
                  If .Cells(1, 1) = "" Then
                  '1seul passage
                     Col = 1
                  Else
                     Col = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
                  End If
                  'on copie l'entete dans une cellule
                  .Cells(1, Col) = Bal
               Else
                  'Si la balise existe déjà sur la feuille, on récupère sa colonne
                  Col = c.Column
               End If
               'et on place la chaine de caractere dans la première cellule vide dans la colonne
               .Cells(.Rows.Count, Col).End(xlUp).Offset(1) = Txt
            End If
            End If
 
 
 
      Next Paragraphe
       'ajout d'une ligne de couleur
        Rows(Ligne + 1).Interior.ColorIndex = 3
        WordDoc.Close
        WordApp.Quit
        Set WordDoc = Nothing
        Set WordApp = Nothing
    End With

[djamat]

Bon j'ai du mal m'exprimer donc voici une explication surement plus claire.

Historique: Ma macro récupère des chaines de caractères à l'aide de balise (exemple: [titre][/titre]dans Word pour les copier dans une feuille excel.

Etat actuel: Les résultats sont copies à la suite et donc le fichier excel n'est plus exploitable car les commentaires (reminder, check...) ne correspondent plus à la première colonne.

Objectif: Insérer une ligne ou fusionner la cellule du "titre" afin que les autres lignes correspondent.

code existant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
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("Feuil2")
        Fichier = "D:\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
         'pour chaque paragraphe on verifie si il y a un [ et un ]
         Txt = Paragraphe.Range.Text
         Deb = InStr(1, Txt, "[")
         Fin = InStr(1, Txt, "]")
 
         'deb & fin seront toujours superieur à 0 si txt a un [ ou ]
         If Deb > 0 And Fin > 0 Then
            'bal recupere le nom de la balise, +1 pour le [ et -2 pour /], donc bal=objective par exemple
            Bal = Mid(Txt, Deb + 1, Fin - 2)
 
            'vérification de la présence d'une balise de fin
            If InStr(1, Txt, "[/" & Bal & "]") > 0 Then
            'deb: calcule le nombre de caractere selon la balise cad "[REMINDER] "=10+1espace
            'fin: compte le nombre de caractere avant la balise avant [/
            'txt: recupere le resultat à afficher
               Deb = InStr(1, Txt, "[" & Bal & "]") + Len("[" & Bal & "]")
               Fin = InStr(1, Txt, "[/" & Bal & "]") - Len("[/" & Bal & "]")
               Txt = Mid(Txt, Deb, Fin)
               'entete de colonne cad bal
               Set c = .Rows(1).Find(Bal, , , xlWhole)
 
               If c Is Nothing Then
               'si la cellule A1 est vide alors colonne prends 1 sinon elle s'incremente;
                  If .Cells(1, 1) = "" Then
                  '1seul passage
                     Col = 1
                  Else
                     Col = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
                  End If
 
                  'on copie l'entete dans une cellule
                  .Cells(1, Col) = Bal
               Else
                  'Si la balise existe déjà sur la feuille, on récupère sa colonne
                  Col = c.Column
               End If
 
               'et on place la chaine de caractere dans la première cellule vide dans la colonne
               .Cells(.Rows.Count, Col).End(xlUp).Offset(1) = Txt
 
            End If
 
         End If
 
 
 
      Next Paragraphe
       'ajout d'une ligne de couleur
        Rows(Ligne + 1).Interior.ColorIndex = 3
        WordDoc.Close
        WordApp.Quit
        Set WordDoc = Nothing
        Set WordApp = Nothing
   End With
 
End Sub

PS: en testant, les 2 fichiers joints la colonne titre est en dernière position (alors qu'elle devrait être en première) mais cela est du à mon fichier Word de test.

Merci par avance pour votre aide et/ou commentaire, please help ...

djamat

[djamat]

Bon finalement je me suis debrouiller comme un grand !

J'ai initialiser 3 marqueurs à 1. Afin de pouvoi se positionner dans le fichier:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'On récupère la première ligne vide de la colonne courante (freeLine)
               freeLine = .Cells(65536, Col).End(xlUp).Row + 1
 
               'On mets à jour les marqueurs
               If Col = 1 Then                    'Si il s'agit de la première colonne (chapitre)
                    startLine = farestLine + 1    'on met à jour le marqueur startLine
               ElseIf freeLine > farestLine Then 'Si besoin, on met à jour le marqueur de celulle vide
                    farestLine = freeLine        'la plus basse dans le fichier (farestLine)
               End If
 
               If startLine >= freeLine Then     'On écrit alors dans la cellule la plus basse entre
                 .Cells(startLine, Col) = Txt    'le dernier marqueur de "chapitre"
               Else                              'et la cellule libre la plus basse de la colonne courante
                 .Cells(freeLine, Col) = Txt
               End If

SI cela peut aider d'autrs personnes ...