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
| Dim colonne, débutOrg, f, forga, inth, intv, Tbl(), n
Sub DessineNomenclatureShapes()
Set forga = Sheets("synoptique")
Set f = Sheets("base de donné")
Tbl = f.Range("A2:B" & f.[A65000].End(xlUp).Row).Value
n = UBound(Tbl)
For Each s In forga.Shapes
If s.Type = 17 Or s.Type = 1 Then s.Delete
Next
Set débutOrg = forga.Range("b4")
colonne = 0
inth = 70
intv = 18
créeShape Tbl(1, 1), 1, Tbl(1, 2)
End Sub
Sub créeShape(parent, niv, Attribut) ' procédure récursive
hauteurshape = 18
largeurshape = 120
colonne = colonne + 1
forga.Shapes.AddShape(msoShapeFlowchartAlternateProcess, 10, 10, largeurshape, hauteurshape).Name = parent
forga.Shapes(parent).Line.ForeColor.SchemeColor = 1
txt = parent & " : " & Attribut
With forga.Shapes(parent)
.TextFrame.Characters.Text = txt
.TextFrame.Characters(Start:=1, Length:=1000).Font.Size = 8
.TextFrame.Characters(Start:=1, Length:=1000).Font.ColorIndex = 0
.TextFrame.Characters(Start:=1, Length:=Len(parent)).Font.Bold = True
.Fill.ForeColor.RGB = f.Cells(2, 1).Interior.Color
.TextFrame.Characters(Start:=1, Length:=Len(parent)).Font.Color = vbRed
End With
forga.Shapes(parent).Left = débutOrg.Left + niv * inth
forga.Shapes(parent).Top = débutOrg.Top + intv * colonne
For i = 2 To n
If Tbl(i, 1) = parent And niv > 1 Then
p = InStrRev(Tbl(i, 1), "."): Shapepère = Left(Tbl(i, 1), p - 1)
forga.Shapes.AddConnector(msoConnectorElbow, 100, 100, 100, 100).Name = parent & "c"
forga.Shapes(parent & "c").Line.ForeColor.SchemeColor = 22
forga.Shapes(parent & "c").ConnectorFormat.BeginConnect forga.Shapes(Shapepère), 3
forga.Shapes(parent & "c").ConnectorFormat.EndConnect forga.Shapes(parent), 2
End If
p = InStrRev(Tbl(i, 1), "."): tmp = Left(Tbl(i, 1), p - 1)
If tmp = parent Then créeShape Tbl(i, 1), niv + 1, Tbl(i, 2)
Next i
End Sub |
