Word - tableau - dispatcher contenu 2 colonnes afin d'égaliser les colonnes

Bonjour à tous,

J'ai un document word que je vais remplir depuis un userform excel. Ce document word est un modèle que je vais adapter à chaque utilisation, je veux disposer le contenu de mon userform (qui sera résumé dans listview1) dans un tableau avec 1 ligne et 2 colonnes, afin simplement d'avoir un affichage de ce contenu sous 2 colonnes.

Le code ci dessous fonctionne mais ne remplit que la première colonne, j'aimerais que la 2ème colonne se remplisse aussi mais de manière intelligente, sans faire "1 item colonne 1, 1 item colonne 2, etc" afin d'éviter d'avoir des colonnes deséquilibrées.

En effet les items peuvent théoriquement faire 3 ou 4 mots dans un cas et 3 ou 4 (ou plus) lignes dans l'autre, et cela peut donc donner des colonnes très déséquilibrées. Comment analyser et disposer le contenu pour avoir un rendu le plus aymétrique / harmonieux possible ?

Voici le code :

Private Sub BtnCompteRendu_Click()
  Dim WordApp As Word.Application
  Dim Otbl As Table, cellule As Cell, myRange As Range, intitulé As String,  contenu As String, ligne As ListItem

    'L’ Instruction On Error si Word n'est pas déjà ouvert.
    On Error Resume Next
    ' Activez Word s'il est déjà ouvert.
    Set WordApp = GetObject(, "Word.Application")
    If Err.Number = 429 Then
    Err.Clear
     'Créez une application Word si Word n'est pas déjà ouvert.
    Set WordApp = CreateObject("word.application") 'ouvre session word et le fichier voulu
    End If
    ' Assurez-vous que l'application Word est visible.
    WordApp.Visible = True
    ' Activez l'application Word.
    WordApp.Activate
    Set WordDoc = WordApp.Documents.Open("C:\Users\arnau\Documents\Arnaud\Logiciel Bilan Kiné\Modèle Courrier.docx") 'ouvre document Word
    WordDoc.Activate

    'Go to InsertBookmark
    WordApp.Selection.GoTo what:=wdGoToBookmark, Name:="Bilan"
    'Insert table near bookmark
    WordDoc.Tables.Add Range:=WordApp.Selection.Range, NumRows:=1, NumColumns:=2
    'identify table
    Set Otbl = WordDoc.Tables(2) 'déjà une table plus haute dans le document

    For Each ligne In ListView1.ListItems
      If ligne.Checked = False Then 'ne rien faire si ligne décochée
      Else
        intitulé = ligne.Text & " : "
        contenu = ligne.ListSubItems(1).Text
        Otbl.Columns(1).Cells(1).Range.InsertAfter vbCrLf & intitulé & contenu

        With WordDoc.Content.Find 'chercher et mettre en gras les intitulés
         .Text = intitulé
         .Forward = True
         .Execute
         If .Found = True Then .Parent.Bold = True
        End With
       End If
     Next ligne

    WordDoc.Fields.Update

End Sub

Merci beaucoup pour vos suggestions !

Re,

Pour ceux qui seraient intéressés, la solution que j'ai trouvé est qui marche est avec le computestatistics(statistic:=wdstatisticLines)

Voici le code si jamais...

    For Each ligne In ListView1.ListItems
      If ligne.Checked = False Then              'ne rien faire si ligne décochée
      Else
        intitulé = ligne.Text & " : "
        contenu = ligne.ListSubItems(1).Text

  Set Col1 = tbl1.Columns(1).Cells(1).Range    'sur ce paragraphe on mesure la taille des colonnes pour après les comparer au moment de les remplir     afin qu'elles ne soient aps déséquilibrées
        Col1.MoveEnd wdCharacter, -1 'd'après l'aide microsoft, obligé de passer par ce bricolage si le range est une cellule de tableau
        TailleCol1 = Col1.ComputeStatistics(Statistic:=wdStatisticLines)
        Set Col2 = tbl1.Columns(2).Cells(1).Range
        Col2.MoveEnd wdCharacter, -1
        TailleCol2 = Col2.ComputeStatistics(Statistic:=wdStatisticLines)
        Select Case ligne.Text

        Case Is = "Ordonnance", "Plainte" ' [rajouter le texte recherché]
          If TailleCol1 > TailleCol2 Then
            tbl1.Columns(2).Cells(1).Range.InsertAfter vbCrLf & intitulé & contenu
          Else
            tbl1.Columns(1).Cells(1).Range.InsertAfter vbCrLf & intitulé & contenu
          End If
        End select 'rajouter les case selon le besoin
    Next ligne
Rechercher des sujets similaires à "word tableau dispatcher contenu colonnes afin egaliser"