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

[sylvanu]

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]

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

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]

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]

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

 

[patricktoulon]

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)

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]

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

c'est
.ForeColor.rgb
et non
ForeColor

 

[sylvanu]

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]

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

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]

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]

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]

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