Discussion :

[7castor]

bonjour,
je voudrai savoir comment éditer dans un shape ou une msgbox des nombres qui sont parfois sous forme de pourcentage parfois sous forme entière ou décimale. Les nombres à éditer sont dans departementInfo1, departementInfo2

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 With Me.Select_Departement
    departementNom = .Value
    'Récupère le code et les infos du departement
    departementNum = Application.Index(oSheet.Range("A2", [A65635].End(xlUp)), .ListIndex + 1, 1)
    departementInfo1 = Application.Index(oSheet.Range("C2", [A65635].End(xlUp)), .ListIndex + 1, 1)
    departementInfo2 = Application.Index(oSheet.Range("D2", [A65635].End(xlUp)), .ListIndex + 1, 1)
    iRang = .ListIndex
End With
'Affiche les nom , code et info du departement
strInfo = " Vous avez cliqué sur le département : " & departementNom & vbNewLine & " Info1 :    " & departementInfo1 & "      Info2 :    " & departementInfo2
shpInfo.DrawingObject.Text = strInfo
Range("C1").Select

Merci pour votre réponse

[Invité]

Bonjour,

Le code ci-dessous génère un rectangle et une flèche puis réalise un groupement et inscrit des informations pour le département de l'Ille et Vilaine.

Les paramètres de positionnement sont à adapter à votre application.

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
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

Cordialement.