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