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...
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
V2 : Ajout position horizontale et verticale texte dans un shape ( feuille Param shapes )
Merci à Patricktoulon.
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
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
Correction du code généré dans la feuille "Param shapes"
Ajout des textures possibles dans la feuille "Propriétés"
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