Inserer une ligne ou fusionner une cellule en fonction des resultats

Question

Bonjour, 

Je planche depuis hier sur une problématique. 

Historique: Ma macro récupère des chaines de caractères à l'aide de balise (exemple: [titre]/titredans 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.

Voici le code existant:
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 + i).Interior.ColorIndex = 3
        WordDoc.Close
        WordApp.Quit
        Set WordDoc = Nothing
        Set WordApp = Nothing
   End With

End Sub 

Voici le fichier doc pour tester:
http://www.casimages.com/f.php?f=130507112333275942.doc

et voici le résultat souhaité:
http://www.casimages.com/f.php?f=13050711331349106.xls

J&#8217;espère avoir été assez clair si besoin je peux être plus précis.

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

baub81

baub81 · Answer

En faite je pense que je devrais mettre un compteur de ligne mais je ne sais pas comment et ou ? 
pour ensuite faire:
tant que le titre n'a pas change alors on compte sinon on ajoute une nouvelle ligne.
Un truc du style ... Please help :)

Utilisateur anonyme · Answer

Bonjour,


Voici le fichier doc pour tester: 
http://www.casimages.com/f.php?f=130507112333275942.doc 

et voici le résultat souhaité: 
http://www.casimages.com/f.php?f=13050711331349106.xls 

Personne ne va prendre le risque d'ouvrir tes fichiers, sauf les gens qui vont te les demander expressément.

baub81 · Answer

Bonjour cmarcotte,

Oui c'est pas faux même moi je téléchargerai pas ces fichiers :). 

En tous cas j'ai réussi, en creant 3 marqueurs ue jai initialisé à 1:

'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 ela peut aider

ucfoutu · Answer

Bonjour,
Commence par corriger :
'On récupère la première ligne vide de la colonne courantela ligne suivant la dernière ligne remplie de la colonne courante (freeLine)
               freeLine =  .Cells( 65536 Rows.count, Col).End(xlUp).Row + 1
La première ligne vide n'est pas forcément celle qui suit la dernière remplie !
65536 est à changer en Rows.count (nb maxi de lignes, quelle que soit la version).


________________________
Réponse exacte ?  => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

baub81 · Answer

bonjour ucfoutu, 

Merci pour cette correcion. 
J'ai encore beaucoup à apprendre en VBa !!

baub81 · Answer

*correction et non correcion :D

Inserer une ligne ou fusionner une cellule en fonction des resultats

6 réponses

Votre réponse

Discussions similaires