Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

Inscrivez vous pour télécharger ce fichier
  • Initiateur de la discussion Initiateur de la discussion sylvanu
  • Date de début Date de début
Vue principale Mises à jour (2) Avis (3) Historique Discussion

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire

sylvanu

XLDnaute Barbatruc
Supporter XLD
sylvanu a soumis une nouvelle ressource:

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


En savoir plus sur cette ressource...
 
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
 
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
 
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.
 
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
 
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 🙂 😉
 
 
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…