Manipuler les shapes ( tuto pour débutants ) V3.0

sylvanu · 28 Août 2023

sylvanu a soumis une nouvelle ressource:

Manipuler les shapes ( tuto pour débutants ) - Shape, Dessiner, WordArt

Beaucoup de formes peuvent être utilisées sous XL ( l'outil en répertorie 181 ), ils peuvent être implémentés simplement ... quand on connait la syntaxe.
Cet outil est une aide pour ces implémentations. Il permet de choisir le shape désiré, y mettre les propriétés voulues ( couleur de fond et bordure, texte ... ) et sa position sur la feuille.
Une feuille est réservée à l'implémentation d'un texte avec WordArt.
Dans la mesure du possible, à chaque exemple est fourni le code VBA qu'il suffit...

En savoir plus sur cette ressource...

patricktoulon · 28 Août 2023

Bonjour Sylvanu
je te propose une mise ajour minimale
en effet tu ne gere pas l'alignement du texte dans la shape
donc
rajoute 6 cellules à ton tableau + les intitulés a gauche (voir capture animée

et pour le code dans ta feuille paramshape

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo Fin2
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [G6:N6]) Is Nothing Then
        ' Couleur de fond
        ActiveSheet.Shapes("Exemple").Fill.ForeColor.RGB = Range(Target.Address).Interior.Color
    ElseIf Not Intersect(Target, [G7:N7]) Is Nothing Then
        ' Couleur de bordure
        ActiveSheet.Shapes("Exemple").Line.ForeColor.RGB = Range(Target.Address).Interior.Color
    ElseIf Not Intersect(Target, [G9:N9]) Is Nothing Then
        ' Epaisseur de bordure
        ActiveSheet.Shapes("Exemple").Line.Weight = Target.Value
    ElseIf Not Intersect(Target, [G8:N8]) Is Nothing Then
        ' Couleur texte
        ActiveSheet.Shapes("Exemple").TextFrame2.TextRange.Characters.Font.Fill.ForeColor.RGB = Range(Target.Address).Interior.Color
    ElseIf Not Intersect(Target, [G10:N10]) Is Nothing Then
        ' Taille du texte
        ActiveSheet.Shapes("Exemple").TextEffect.FontSize = Target.Value
    ElseIf Not Intersect(Target, [G11]) Is Nothing Then
        ' Texte normal
        With ActiveSheet.Shapes("Exemple").TextEffect
            .FontBold = False
            .FontItalic = False
        End With
    ElseIf Not Intersect(Target, [H11]) Is Nothing Then
        ' Texte gras
        ActiveSheet.Shapes("Exemple").TextEffect.FontBold = True
    ElseIf Not Intersect(Target, [I11]) Is Nothing Then
        ' Texte italique
        ActiveSheet.Shapes("Exemple").TextEffect.FontItalic = True

    ElseIf Not Intersect(Target, [G12]) Is Nothing Then
        'alignement horizontal du texte  a gauche
        ActiveSheet.Shapes("Exemple").TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignLeft

    ElseIf Not Intersect(Target, [H12]) Is Nothing Then
        'alignement horizontal du texte  au milieu
        ActiveSheet.Shapes("Exemple").TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter

    ElseIf Not Intersect(Target, [I12]) Is Nothing Then
        'alignement horizontal du texte  a droite
        ActiveSheet.Shapes("Exemple").TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignRight

    ElseIf Not Intersect(Target, [G13]) Is Nothing Then
        'alignement vertical  du texte en haut
        ActiveSheet.Shapes("Exemple").TextFrame2.VerticalAnchor = msoAnchorTop

    ElseIf Not Intersect(Target, [H13]) Is Nothing Then
        'alignement vertical  du texte  au milieu
        ActiveSheet.Shapes("Exemple").TextFrame2.VerticalAnchor = msoAnchorMiddle

    ElseIf Not Intersect(Target, [I13]) Is Nothing Then
        'alignement vertical du texte  en bas
        ActiveSheet.Shapes("Exemple").TextFrame2.VerticalAnchor = msoAnchorBottom
    End If
    ' Génère le code correspondant
    CodeGénéré
Fin2:
End Sub

sylvanu · 28 Août 2023

sylvanu a mis à jour Manipuler les shapes ( tuto pour débutants ) avec une nouvelle entrée de mise à jour:

Manipuler les shapes ( tuto pour débutants )

V2 : Ajout position horizontale et verticale texte dans un shape ( feuille Param shapes )
Merci à Patricktoulon.

Lire le reste de cette entrée de mise à jour...

sylvanu · 28 Août 2023

Bonjour Patrcicktoulon.
Fait et publié.
Merci pour l'idée. 🙂

patricktoulon · 28 Août 2023

re
tu a modifié le code "codegénéré" aussi?
je te l'ai modifié et il code les valeurs textuelles des constantes et non leur valeur(0,-1)=(False,True)

VB:

Sub CodeGénéré()
    Dim T(1 To 16, 1 To 11)
    Application.ScreenUpdating = False
    With ActiveSheet.Shapes("Exemple")
        T(1, 1) = "Sub ExempleShape()"
        T(2, 2) = "Set Sh = ActiveSheet.Shapes.AddShape(" & TypeShape & ", 80, 50, 110, 110)"
        T(2, 11) = "' Incrustation du shape"
        T(3, 2) = "Sh.Name = ""Exemple"""
        T(3, 11) = "' Donne un nom au shape"
        T(4, 2) = "With ActiveSheet.Shapes(""Exemple"")"
        T(5, 3) = ".TextFrame2.TextRange.Text = ""TEXTE"""
        T(5, 11) = "' Met le texte dans le shape"
        T(6, 3) = ".Fill.ForeColor=" & .Fill.ForeColor
        T(6, 11) = "' Couleur du fond"
        T(7, 3) = ".Line.ForeColor=" & .Line.ForeColor
        T(7, 11) = "' Couleur de la bordure"
        T(8, 3) = ".Line.Weight =" & .Line.Weight
        T(8, 11) = "' Epaisseur de la bordure"
        T(9, 3) = ".TextFrame2.TextRange.Characters.Font.Fill.ForeColor =" & .TextFrame2.TextRange.Characters.Font.Fill.ForeColor
        T(9, 11) = "' Couleur du texte"
        T(10, 3) = ".TextEffect.FontSize = " & .TextEffect.FontSize
        T(10, 11) = "' Taille de la police"
        T(11, 3) = ".TextEffect.FontBold = " & Array("False", "True")(Abs(.TextEffect.FontBold))
        T(11, 11) = "' Texte en gras"
        T(12, 3) = ".TextEffect.FontItalic =" & Array("False", "True")(Abs(.TextEffect.FontItalic))
        T(12, 11) = "' Texte en italique"
        T(13, 3) = ".TextFrame2.TextRange.ParagraphFormat.Alignment =" & Array(, "msoAlignLeft", "msoAlignCenter", "msoAlignRight")(.TextFrame2.TextRange.ParagraphFormat.Alignment)
        T(13, 11) = "' alignement horizontal du texte"
        T(14, 3) = ".TextFrame2.VerticalAnchor = msoAnchorMiddle =" & Array(, "msoAnchorTop", , "msoAnchorMiddle", "msoAnchorBottom")(.TextFrame2.VerticalAnchor)
        T(14, 11) = "' alignement horizontal du texte"
        T(15, 2) = "End With"
        T(16, 1) = "End Sub"
    End With
    [C17].Resize(UBound(T, 1), UBound(T, 2)) = T
End Sub

patricktoulon · 30 Août 2023

re
il y a encore une erreur dans ton codegénéré

c'est
.ForeColor.rgb
et non
ForeColor

sylvanu · 30 Août 2023

Re,
J'en ai trouvé d'autres, toutes les lignes qui font appel à une couleur.
J'en ai profité pour mettre sur la forme RGB(r,g,b) plus lisible, ainsi que les centrages avec leur paramètre en texte au lieu du numéro.
Je vais revérifié avant de le mettre à disposition.
Merci encore.

patricktoulon · 30 Août 2023

re
ben oui je n'avais pas compris pourquoi tu n'avais pas corrigé avec les constantes textuelles
y compris pour les fonts (true/false au lieu de 0 ou -1

VB:

Sub CodeGénéré()
    Dim T(1 To 16, 1 To 11)
    Application.ScreenUpdating = False
    With ActiveSheet.Shapes("Exemple")
        T(1, 1) = "Sub ExempleShape()"
        T(2, 2) = "Set Sh = ActiveSheet.Shapes.AddShape(" & TypeShape & ", 80, 50, 110, 110)"
        T(2, 11) = "' Incrustation du shape"
        T(3, 2) = "Sh.Name = ""Exemple"""
        T(3, 11) = "' Donne un nom au shape"
        T(4, 2) = "With ActiveSheet.Shapes(""Exemple"")"
        T(5, 3) = ".TextFrame2.TextRange.Text = ""TEXTE"""
        T(5, 11) = "' Met le texte dans le shape"
        T(6, 3) = ".Fill.ForeColor.RGB=" & .Fill.ForeColor
        T(6, 11) = "' Couleur du fond"
        T(7, 3) = ".Line.ForeColor.RGB=" & .Line.ForeColor
        T(7, 11) = "' Couleur de la bordure"
        T(8, 3) = ".Line.Weight =" & .Line.Weight
        T(8, 11) = "' Epaisseur de la bordure"
        T(9, 3) = ".TextFrame2.TextRange.Characters.Font.Fill.ForeColor.RGB =" & .TextFrame2.TextRange.Characters.Font.Fill.ForeColor
        T(9, 11) = "' Couleur du texte"
        T(10, 3) = ".TextEffect.FontSize = " & .TextEffect.FontSize
        T(10, 11) = "' Taille de la police"
        T(11, 3) = ".TextEffect.FontBold = " & Array("False", "True")(Abs(.TextEffect.FontBold))
        T(11, 11) = "' Texte en gras"
        T(12, 3) = ".TextEffect.FontItalic =" & Array("False", "True")(Abs(.TextEffect.FontItalic))
        T(12, 11) = "' Texte en italique"
        T(13, 3) = ".TextFrame2.TextRange.ParagraphFormat.Alignment =" & Array(, "msoAlignLeft", "msoAlignCenter", "msoAlignRight")(.TextFrame2.TextRange.ParagraphFormat.Alignment)
        T(13, 11) = "' alignement horizontal du texte"
        T(14, 3) = ".TextFrame2.VerticalAnchor = msoAnchorMiddle =" & Array(, "msoAnchorTop", , "msoAnchorMiddle", "msoAnchorBottom")(.TextFrame2.VerticalAnchor)
        T(14, 11) = "' alignement horizontal du texte"
        T(15, 2) = "End With"
        T(16, 1) = "End Sub"
    End With
    [C17].Resize(UBound(T, 1), UBound(T, 2)) = T
End Sub

et il y a d'autre alternative de code aussi si ca t'intéresse dis le moi

sylvanu · 3 Septembre 2023

sylvanu a mis à jour Manipuler les shapes ( tuto pour débutants ) avec une nouvelle entrée de mise à jour:

Corrections

Correction du code généré dans la feuille "Param shapes"
Ajout des textures possibles dans la feuille "Propriétés"

Lire le reste de cette entrée de mise à jour...

oguruma · 6 Septembre 2023

Hello, je viens de tester un peu plus en profondeur.....
Ouaaa La Va.....che
tu as fait un Taff de Oufff !!!
c'est clair que les secrets vont êtes levés, plus besoin de lancer une macro en mode recording pour identifier le code produit par excel et ensuite se l'appropier 🙂 😉

oguruma · 6 Septembre 2023

oguruma à dit:
Hello, je viens de tester un peu plus en profondeur.....
Ouaaa La Va.....che
tu as fait un Taff de Oufff !!!
c'est clair que les secrets vont être levés, plus besoin de lancer une macro en mode recording pour identifier le code produit par excel et ensuite se l'appropier 🙂 😉

Effectuez une recherche sur Excel Downloads...

Manipuler les shapes ( tuto pour débutants ) V3.0

sylvanu

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

oguruma

XLDnaute Impliqué

oguruma

XLDnaute Impliqué

Nous accordons de l'importance à votre vie privée