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
|
Sub CreerUneEchelle()
Dim I As Integer, IndexMatrice As Integer, PremierShape As Integer
Dim PositionX As Single, ValeurDuPas As Single, PositionXDebut As Single, PositionXFin As Single
Dim MatriceShapes() As Variant
ValeurDuPas = 10#
PositionXDebut = 100#
PositionX = PositionXDebut
IndexMatrice = 0
With ActiveDocument
Application.ScreenUpdating = False
' Barres verticales
PremierShape = .Shapes.Count
For I = PremierShape + 1 To PremierShape + 20
CreerUneBarre ActiveDocument, I, "BV" & I, PositionX, 195, PositionX, 200
ReDim Preserve MatriceShapes(IndexMatrice)
MatriceShapes(IndexMatrice) = "BV" & I
IndexMatrice = IndexMatrice + 1
PositionX = PositionX + ValeurDuPas
Next I
' Barre horizontale
PositionXFin = PositionX - ValeurDuPas
ReDim Preserve MatriceShapes(IndexMatrice)
MatriceShapes(IndexMatrice) = "BH" & I
CreerUneBarre ActiveDocument, I, "BH" & I, PositionXDebut, 200, PositionXFin, 200
' Groupement des barres
.Shapes.Range(MatriceShapes).Select
Selection.ShapeRange.Group.Select
Selection.ShapeRange.Name = "Groupe " & .Shapes.Count
Application.ScreenUpdating = True
End With
End Sub
Sub CreerUneBarre(ByVal DocEncours As Document, ByVal NumeroShape As Integer, ByVal NomDeLaBarre As String, ByVal CoordX1 As Single, ByVal CoordY1 As Single, ByVal CoordX2 As Single, ByVal CoordY2 As Single)
Dim NumeroShapes As Long
With DocEncours
.Shapes.AddLine(CoordX1, CoordY1, CoordX2, CoordY2).Select
.Shapes(NumeroShape).Name = NomDeLaBarre
End With
End Sub |
