Discussion :

[PhilippeF75]

Bonjour à tous,
Je cherche à déterminer les dimensions (hauteur et largeur) d'un texte dans un document Word afin d'insérer une image dont la taille sera adaptée à l'emplacement libre.
Je précise exactement : par macros, je formate un texte dans un document Word qui ne peut excéder une page A4. La largeur du texte est connue puisque je connais la largeur de la page et des marges. Mais comment connaître la hauteur du texte (qui est évidemment liée à la taille de la fonte, des interlignes et des espacements de paragraphes) pour déterminer la hauteur de page disponible afin d'y insérer une image redimensionnée pour tenir dans cette emplacement.
Nota, je sais placer et dimensionner l'image. Mais je ne sais calculer la hauteur libre sous le texte.
Help me please...
Pour la petite histoire, cette appli est dans un exécutable obtenu par Visual Studio Express programmé en VB, mais cela ne change rien à la chose car il est facile de passer d'une macro VBA à une procédure VB.
Merci d'avance pour vos lumières.

[clementmarcotte]

Bonjour,

À première vue, et à ma souvenance, il n'y a pas de méthode directe et simple d'obtenir la surface occupée par un texte en VBA. Même que je me demande si VB.net ne serait pas mieux outillé pour faire cela.

Mais, là, en fouillant dans MSDN j'entrevois une petite porte de sortie que tu pourrais peut-être essayer :

En utilisant Selection.information tu peux apparemment, désolé, je n'ai jamais essayé, trouver la position relative (en points) de ta sélection en fonction de ta page.

Ce qu'il y a de bien avec ton objet Selection, mais tu le sais probablement déjà, c'est que quand il n'y a pas de sélection active, c'est le "curseur". Donc, une fois que tu as positionné ton "curseur" à la fin de ton texte et effectué un certain nombre de calculs, je pense que tu pourrais arriver à quelque chose de pas si pire.

Je présume que tu sais également que Word dispose en interne des fonctions/méthodes pour convertir des pouces, et peut-être des centimètres en points et vice-versa.

Avant de fouiller dans MSDN, j'avais pensé d'y aller par essais et erreurs en détectant la variation du nombre de sauts de pages, mais c'est probablement plus aléatoire.

P.S. Si jamais, tu y arrives, j'aimerais bien voir ton code. Je devrais probablement le modifier un peu, parce que notre format lettre est différent de votre A4 et que le vieux que je suis ne s'est jamais adapté à un Word en centimètres, mais bon...

[PhilippeF75]

Merci de ta réponse que je teste rapidement. C'est en effet une voie qui semble praticable.

[PhilippeF75]

Ton idée était la bonne !
Voici la macro testée avec succès en VBA dans une macro Word ; je n'ai pas encore testé en VB.
Préalable : j'ai d'abord créé le document Word, écrit et mis en forme le texte. Là j'arrive à l'insertion de l'image sous le texte, je la centre et la redimensionne.
NB : J'ai gardé les mesures en points pour la programmation

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
 
Sub Place_Image()
  ficImage = "C:\MonChemin\MonFichier.jpg"
  With ThisDocument
    ' Largeur disponible
    Wdispo = .PageSetup.PageWidth - .PageSetup.LeftMargin - .PageSetup.RightMargin
    ' Calcul de la hauteur disponible
    Selection.EndKey Unit:=wdStory
    Hdispo = .PageSetup.PageHeight - Selection.Information(wdVerticalPositionRelativeToPage) - Selection.Font.Size - .PageSetup.BottomMargin
    ' ajout de l'illustration après un saut de section continu (c'est un besoin dans mon doc)
    .Paragraphs.Add
    With .Paragraphs(.Paragraphs.Count)
      With .Range
        .Collapse Direction:=wdCollapseStart
        .InsertBreak Type:=wdSectionBreakContinuous
        .InsertParagraphAfter
        .Text = ""
         .InlineShapes.AddPicture FileName:=ficImage, LinkToFile:=False, SaveWithDocument:=True
      End With
    End With
    .InlineShapes.Item(1).ConvertToShape
    With .Shapes.Item(1)
      Himg = .Height
      Wimg = .Width
      ' Petite moulinette sur le calcul du ratio de redimensionnement de l'image pour optimiser la place disponible
      ratio = IIf(Hdispo * Wimg / Himg > Wdispo, Wdispo / Wimg, Hdispo / Himg)
      .Height = Himg * ratio
      .Width = Wimg * ratio
      .Left = (Wdispo - .Width) / 2
    End With
  End With
End Sub

[PhilippeF75]

Bon, voilà le code définitif complet testé en VB dans Visual Studio Express à la demande de clementmarcotte (encore un grand merci pour son aide).
Tout fonctionne bien.
Pour info, il s'agit d'une procédure entière qui me sert à créer un document Word d'une page A4 recto seulement pour formater les sujets d'examen oral du BTS d'anglais.
Le format Word en est très précis et imposé par le rectorat. C'est pour éviter les propositions exotiques non conformes que j'ai mis cette procédure au point qui fait partie d'un projet global de soumission des sujets par les profs pour examen en commission.
La procédure est suivie d'une fonction CmToPoint qui convertit les mesures en cm en mesures en points, unité typographique utilisée par Word.

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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
 
  Sub CreationFichierDoc()
    ' Création d'un fichier Word
    ' On part du principe que les variables suivantes sont soit publiques (c'est le cas ici), soit passées en arguments de la procédure :
    ' strSession, intNumBTS, BTS(intNumBTS).strNom, strTitreSujet, strNomDocument, intNbrMots, strSourceDocument, dteDateDocument,
    ' strTexteSujet, strChemin, strFicImg, strFicDoc
    Dim oWord As Word.Application
    Dim oDoc As Word.Document
    Dim sngLargeurDispo As Single, sngHauteurDispo As Single, sngHauteurImage As Single, sngLargeurImage As Single
    oWord = CreateObject("Word.Application")
    oWord.Visible = True
    oDoc = oWord.Documents.Add
 
    ' Mise en forme
    With oDoc
      ' mise en page marges
      .Range.Font.Name = "Arial"
      With .PageSetup
        .Orientation = Word.WdOrientation.wdOrientPortrait
        .TopMargin = CmToPoint(2)
        .BottomMargin = CmToPoint(2)
        .LeftMargin = CmToPoint(2)
        .RightMargin = CmToPoint(2)
        .PageWidth = CmToPoint(21)
        .PageHeight = CmToPoint(29.7)
        .VerticalAlignment = Word.WdVerticalAlignment.wdAlignVerticalTop
      End With
      ' création et formatage de l'en-tête
      With .Sections(1).Headers(Word.WdHeaderFooterIndex.wdHeaderFooterPrimary)
        .Range.Text = "ACADÉMIE DE LA GUADELOUPE - ANGLAIS - SESSION " & strSession & vbLf & BTS(intNumBTS).strNom
      End With
      With .StoryRanges(Word.WdStoryType.wdPrimaryHeaderStory)
        .Font.Name = "Arial"
        .Font.Size = 14
        .Bold = True
        With .ParagraphFormat
          .Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter
          .SpaceAfter = 6
        End With
      End With
      ' création et formatage du titre du sujet
      With .Paragraphs(.Paragraphs.Count)
        With .Range
          .InsertParagraphAfter
          .Text = "Sujet : " & strTitreSujet
          .Bold = True
          .Font.Size = 12
          .Words(1).Font.Underline = Word.WdUnderline.wdUnderlineSingle
        End With
        With .Format
          .Alignment = Word.WdParagraphAlignment.wdAlignParagraphLeft
          .SpaceBefore = 6
          .SpaceAfter = 6
        End With
      End With
      ' création et formatage du nom du document
      .Paragraphs.Add
      With .Paragraphs(.Paragraphs.Count)
        With .Range
          .InsertParagraphAfter
          .Text = "Document : " & strNomDocument & " (" & intNbrMots & " words)"
          .Bold = True
          .Font.Size = 12
          .Words(1).Font.Underline = Word.WdUnderline.wdUnderlineSingle
        End With
        With .Format
          .Alignment = Word.WdParagraphAlignment.wdAlignParagraphLeft
          .SpaceAfter = 6
        End With
      End With
      ' création et formatage de la source du document
      .Paragraphs.Add
      With .Paragraphs(.Paragraphs.Count)
        With .Range
          .InsertParagraphAfter()
          .Text = "Source : " & strSourceDocument & "  (" & dteDateDocument & ")"
          .Bold = True
          .Font.Size = 12
          .Words(1).Font.Underline = Word.WdUnderline.wdUnderlineSingle
        End With
        With .Format
          .Alignment = Word.WdParagraphAlignment.wdAlignParagraphLeft
          .SpaceAfter = 6
        End With
      End With
      ' création et formatage du texte du sujet après un saut de section continu
      .Paragraphs.Add
      With .Paragraphs(.Paragraphs.Count)
        With .Range
          .Collapse(Word.WdCollapseDirection.wdCollapseStart)
          .InsertBreak(Word.WdBreakType.wdSectionBreakContinuous)
          .InsertParagraphAfter()
          .Text = strTexteSujet
          .Bold = False
          .Font.Size = 12
        End With
      End With
      ' Calcul de la largeur disponible (largeur de la page sans les marges)
      sngLargeurDispo = .PageSetup.PageWidth - .PageSetup.LeftMargin - .PageSetup.RightMargin
      ' Calcul de la hauteur disponible (distance entre la fin du texte et le bas de page sans la marge basse)
      oWord.Selection.EndKey(Word.WdUnits.wdStory)
      sngHauteurDispo = .PageSetup.PageHeight - oWord.Selection.Information(Word.WdInformation.wdVerticalPositionRelativeToPage) _
                                    - oWord.Selection.Font.Size - .PageSetup.BottomMargin
      ' ajout de l'illustration après un saut de section continu
      .Paragraphs.Add
      With .Paragraphs(.Paragraphs.Count)
        With .Range
          .Collapse(Word.WdCollapseDirection.wdCollapseStart)
          .InsertBreak(Word.WdBreakType.wdSectionBreakContinuous)
          .InsertParagraphAfter()
          .Text = ""
          .Bold = False
          .Font.Size = 12
          .InlineShapes.AddPicture(strChemin & "Bis\" & strFicImg, False, True)
        End With
      End With
      .InlineShapes.Item(1).ConvertToShape()
      With .Shapes.Item(1)
        sngHauteurImage = .Height
        sngLargeurImage = .Width
        ratio = IIf(sngHauteurDispo * sngLargeurImage / sngHauteurImage > sngLargeurDispo, sngLargeurDispo / sngLargeurImage, sngHauteurDispo / sngHauteurImage)
        .Height = sngHauteurImage * ratio
        .Width = sngLargeurImage * ratio
        .Left = (sngLargeurDispo - .Width) / 2
      End With
      ' création de la numérotation des lignes de la section 2 (texte du sujet)
      With .Sections(2).PageSetup.LineNumbering
        .Active = True
        .StartingNumber = 1
        .CountBy = 5
        .RestartMode = Word.WdNumberingRule.wdRestartContinuous
        .DistanceFromText = CmToPoint(0.4)
      End With
 
      ' Sauvegarde du fichier
      .SaveAs(strFicDoc)
      .Close(False)
    End With
    oDoc = Nothing
    oWord.Quit()
    oWord = Nothing
  End Sub
 
  Function CmToPoint(ByRef sngMesure As Single) As Single
    ' Conversion des mesures en cm en point pour Word (1 point = env. 0,35 mm)
    CmToPoint = sngMesure / 0.035
  End Function

[clementmarcotte]

Bonjour,

Merci pour le retour.