Discussion :

[ffb.boy.30]

Bonjour,
Je possède un tableau de 4 colonnes X/Y/taille(L,l)/ID et un bouton dans ma première feuille
Je voudrais avec un bouton, dessiner dans ma deuxième feuille une série de forme de dimension (L,l) de position X/Y avec un texte verticale correspondant à l'ID.
ça devrait ressembler à ça
Feuille 1


Feuille 2


Je ne sais pas combien j'aurai de ligne.
J'en suis juste au stade de savoir si c'est faisable.

Merci pour votre aide

[Fab_de_chez_PERFORM]

Bonjour
voici une petite solution
sans doute le code pourra t il etre optimisé : à minima, il faudra prévoir de virer les formes sur la feuille 2 sinon une même forme superposera l'ancienne exécution de macro + il faudra executer un loop afin que la macro bascule de ligne en ligne depuis feuille 1

Voilà le code que j'ai mis dans le fichier joint :

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
Sub Création_Forme()
'
' Création_Forme Macro
'
Sheets("Feuil1").Select
Dim Ma_Ligne
Ma_Ligne = 2 'mettre le loop sur cette valeur
 
Dim MonX, MonY, MaH, MaLa, MaCouleur
MonX = Range("A" & Ma_Ligne).Value
MonY = Range("B" & Ma_Ligne).Value
MaH = Range("C" & Ma_Ligne).Value
MaLa = Range("D" & Ma_Ligne).Value
MaCouleur = Range("F" & Ma_Ligne).Interior.Color
        'conversion Couleur en RGB
        R = Int(MaCouleur Mod 256)
        G = Int((MaCouleur Mod 65536) / 256)
        B = Int(MaCouleur / 65536)
 
Dim MonID As String
MonID = Range("E" & Ma_Ligne).Value
 
    Sheets("Feuil2").Select
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, 0, 0, 100, 100).Select
    Selection.ShapeRange.Name = "Forme_Ligne_" & Ma_Ligne
    'Selection.Name = "Forme_Ligne_" & Ma_Ligne
    Selection.ShapeRange.Height = MaH
    Selection.ShapeRange.Width = MaLa
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(R, G, B)
        .Transparency = 0
        .Solid
    End With
    Selection.ShapeRange.Line.Visible = msoFalse
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = MonID
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 4). _
        ParagraphFormat
        .FirstLineIndent = 0
        .Alignment = msoAlignCenter
    End With
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 4).Font
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorLight1
        .Fill.ForeColor.TintAndShade = 0
        .Fill.ForeColor.Brightness = 0
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 11
        .Name = "+mn-lt"
    End With
    Selection.ShapeRange.IncrementLeft MonX
    Selection.ShapeRange.IncrementTop MonY
    Sheets("Feuil1").Select
End Sub

[ffb.boy.30]

Super merci.
J'ai pioché dans ton code ça m'a bien aidé.
Sais-tu si on peut mettre une info-bulle sur un shape ?

Merci

[Fab_de_chez_PERFORM]

Salut
peut être essayer avec un truc du style

Code :

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

1
2
 
.ShapeRange.AlternativeText = "Decription_Info_Bulle"

[ffb.boy.30]

Merci pour l'info
ça compile et ça joue sans erreur par contre l'infobulle ne fonctionne pas, ni en passant ni en cliquant sur les shapes que j'ai créé.
Je vais fouiller sur cette lancée