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
| Option Explicit
Sub TesterEcriture()
Dim DepartementNom As String
Dim DepartementInfo1 As Variant
Dim DepartementInfo2 As Variant
Dim NatureValeur As String
DepartementNom = "Ille et Vilaine"
DepartementInfo1 = 10
DepartementInfo2 = 50
' NatureValeur = "Alphanumérique"
' NatureValeur = "Pourcentage entier"
NatureValeur = "Pourcentage décimal"
Call Ecriture("Oui", DepartementNom, DepartementInfo1, DepartementInfo2, NatureValeur)
End Sub
Sub Ecriture(Remplissage As String, NomDuDepartement As String, DepartementInformation1 As Variant, DepartementInformation2 As Variant, DonneesType As String)
Dim LongueurDuCadre As Integer
Dim HauteurDuCadre As Integer
Dim PositionGaucheDuCadre As Integer
Dim PositionHautDuCadre As Integer
Dim PositionGaucheDebutFleche As Integer
Dim PositionHautDebutFleche As Integer
Dim PositionGaucheFinFleche As Integer
Dim PositionHautFinFleche As Integer
PositionGaucheDuCadre = 100
PositionHautDuCadre = 100
LongueurDuCadre = 200
HauteurDuCadre = 40
ActiveSheet.Shapes.AddShape(msoShapeRectangle, PositionGaucheDuCadre, PositionHautDuCadre, LongueurDuCadre, HauteurDuCadre).Select
With Selection
.Name = "Cadre1"
.HorizontalAlignment = xlJustify
.VerticalAlignment = xlCenter
.Orientation = xlHorizontal
Select Case DonneesType
Case "Alphanumérique"
.Characters.Text = " Vous avez cliqué sur le département : " & NomDuDepartement & Chr(10) & " Info1 : " & DepartementInformation1 & " Info2 : " & DepartementInformation2
Case "Pourcentage entier"
.Characters.Text = " Vous avez cliqué sur le département : " & NomDuDepartement & Chr(10) & " Info1 : " & FormatNumber(DepartementInformation1, 0) & " % Info2 : " & FormatNumber(DepartementInformation2, 0) & " %"
Case "Pourcentage décimal"
.Characters.Text = " Vous avez cliqué sur le département : " & NomDuDepartement & Chr(10) & " Info1 : " & FormatNumber(DepartementInformation1, 1) & " % Info2 : " & FormatNumber(DepartementInformation2, 1) & " %"
End Select
.Font.Name = "Arial"
.Font.FontStyle = "Gras"
.Font.Size = 8
.Font.ColorIndex = xlAutomatic
End With
With Selection.ShapeRange
If Remplissage = "Non" Then
.Fill.Visible = msoFalse
Else
.Fill.Visible = msoTrue
End If
.Fill.Transparency = 0#
.Fill.ForeColor.RGB = RGB(255, 255, 255)
.Line.Weight = 1.25
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
.Line.ForeColor.RGB = RGB(56, 93, 138)
End With
PositionGaucheDebutFleche = PositionGaucheDuCadre + LongueurDuCadre / 2
PositionHautDebutFleche = PositionHautDuCadre + HauteurDuCadre
PositionGaucheFinFleche = PositionGaucheDuCadre + LongueurDuCadre / 2
PositionHautFinFleche = PositionHautDuCadre + HauteurDuCadre + 30
ActiveSheet.Shapes.AddLine(PositionGaucheDebutFleche, PositionHautDebutFleche, PositionGaucheFinFleche, PositionHautFinFleche).Select
Selection.Name = "Fleche1"
With Selection.ShapeRange
.Line.EndArrowheadStyle = msoArrowheadTriangle
.Line.EndArrowheadLength = msoArrowheadLengthMedium
.Line.EndArrowheadWidth = msoArrowheadWidthMedium
.Line.Weight = 0.75
.Line.ForeColor.RGB = RGB(56, 93, 138)
' .Nodes.Insert 1, msoSegmentLine, msoEditingAuto, 270, 155
End With
ActiveSheet.Shapes.Range(Array("Cadre1", "Fleche1")).Select
Selection.ShapeRange.Group.Select
Selection.Name = "Cadre1EtFleche1"
End Sub
Sub SupprimerShapes()
ActiveSheet.Shapes("Cadre1EtFleche1").Delete
End Sub |
