XL 2016 Bouton avec 2 macro (Position 1 - Position initiale)

Mel976 · 26 Septembre 2023

Bonjour à tous,

N'ayant pas réussi à adapter les codes que j'ai pu trouver sur internet à mon cas. De plus mon niveau en VBA étant proche de 0. Je me résigne donc à demander de l'aide.

J'ai créé un bouton "OK" qui lorsque l'on clique dessus se renomme "PAS OK " et modifie une pastille rouge en vert.

Je souhaiterais qu'avec ce même bouton en cliquant une 2ème fois dessus, celui-ci se remet en position initiale.
> Bouton "OK"
> Pastille couleur Rouge

J'ai déjà créé une macro pour chaque (OK et PasOK) mais comme on ne peut affecter qu'une seule macro à un bouton je ne sais plus quoi faire

D'avance, merci pour votre aide.

sylvanu · 26 Septembre 2023

Bonjour Mel, et bienvenu sur XLD,
Voir PJ avec :

VB:

Sub Ex()
With ActiveSheet.Shapes("Bouton")
    If .TextFrame2.TextRange.Text = "OK" Then
        .TextFrame2.TextRange.Text = "PAS OK"
        .Fill.ForeColor.RGB = RGB(0, 255, 0)
        .TextFrame2.TextRange.Characters.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
    Else
        .TextFrame2.TextRange.Text = "OK"
        .Fill.ForeColor.RGB = RGB(255, 0, 0)
        .TextFrame2.TextRange.Characters.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
    End If
End With
End Sub

Voir aussi le tuto sur les shapes :

Manipuler les shapes ( tuto pour débutants )

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...

excel-downloads.com

Staple1600 · 26 Septembre 2023

Bonsoir le fil

Une autre syntaxe pour les IIFophiles

VB:

Sub Ex_B()
Dim sh As Shape
Set shp = ActiveSheet.Shapes("Bouton")
With shp
    .TextFrame2.TextRange.Text = IIf(.TextFrame2.TextRange.Text = "OK", " PAS OK", "OK")
    .Fill.ForeColor.RGB = IIf(.Fill.ForeColor.RGB = vbGreen, vbRed, vbGreen)
End With
End Sub

patricktoulon · 26 Septembre 2023

Bonsoir
une autre proposition pour les BOOLEANophiles
et les adeptes de l'utilisation de la collection d'object "DrawingObjects"

VB:

Sub Ex_B()
    With ActiveSheet.DrawingObjects("Bouton")
        .Characters.Text = Array("OK", " PAS OK")(Abs(.Characters.Text = "OK"))
        .Interior.Color = Array(vbRed, vbGreen)(Abs(.Characters.Text = "OK"))
    End With
End Sub

Staple1600 · 26 Septembre 2023

@patricktoulon (bonsoir)
Ta macro devrait être nommée Ex_C
Sinon deux Ex_B dans VBE, ce sera de l'excès

OK je sors

patricktoulon · 27 Septembre 2023

re
Bonjour a tous
tiens on peut s'amuser a faire multi position avec un match aussi
et dans ce cas là dans les arrays ,le dernier doit être identique au premier

VB:

Sub Ex_B()
  Dim X, Z,y
  With ActiveSheet.DrawingObjects("Bouton")
        x = Array("OK", " PAS OK", "peut être", "je sais pas", "pas du tout", "OK")
        Z = Array(vbBlue, vbRed, vbMagenta, vbYellow, vbCyan, vbBlue)
        y = Application.Match(.Characters.Text, x, 0)
        .Characters.Text = x(y)
        .Interior.Color = Z(y)
    End With
End Sub

Mel976 · 28 Septembre 2023

sylvanu à dit:

Bonjour Mel, et bienvenu sur XLD,
Voir PJ avec :

VB:

Sub Ex()
With ActiveSheet.Shapes("Bouton")
    If .TextFrame2.TextRange.Text = "OK" Then
        .TextFrame2.TextRange.Text = "PAS OK"
        .Fill.ForeColor.RGB = RGB(0, 255, 0)
        .TextFrame2.TextRange.Characters.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
    Else
        .TextFrame2.TextRange.Text = "OK"
        .Fill.ForeColor.RGB = RGB(255, 0, 0)
        .TextFrame2.TextRange.Characters.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
    End If
End With
End Sub

Bonjour,

Je te remercie pour ton message, mais là partie du code ci-dessous bloque:

.TextFrame2.TextRange.Characters.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)

sylvanu · 28 Septembre 2023

Mel976 à dit:
mais là partie du code ci-dessous bloque:

Dans ma PJ ?
Cela devrait donner ça :

patricktoulon · 28 Septembre 2023

re
essayez l'autre méthode d'approche

XL 2016 - Bouton avec 2 macro (Position 1 - Position initiale)

Bonjour à tous, N'ayant pas réussi à adapter les codes que j'ai pu trouver sur internet à mon cas. De plus mon niveau en VBA étant proche de 0. Je me résigne donc à demander de l'aide. J'ai créé un bouton "OK" qui lorsque l'on clique dessus se renomme "PAS OK " et modifie une pastille rouge en...

excel-downloads.com

patricktoulon · 28 Septembre 2023

re
la voici avec le font color

VB:

Sub Ex_Z()
    With ActiveSheet.DrawingObjects("Bouton")
        .Characters.Text = Array("OK", " PAS OK")(Abs(.Characters.Text = "OK"))
        .Interior.Color = Array(vbRed, vbGreen)(Abs(.Characters.Text = "OK"))
        .Font.Color = Array(vbWhite, vbBlack)(Abs(.Characters.Text = "OK"))
    End With
End Sub

on constate quoi;
et bien que les property sont les même que les cells (interior.color/ font.color)
et ces property sont child direct de l'object

@sylvanu: c'est l'autre alternative dont je te parlais dans ta ressource
voilà

de même que passer par la collection shapes ne t'empeche pas de passer par l'object "DrawingObject" (sans le "s") afin de simplifier l'acces aux property

VB:

Sub Ex_Z()
    With ActiveSheet.Shapes("Bouton").DrawingObject
        .Characters.Text = Array("OK", " PAS OK")(Abs(.Characters.Text = "OK"))
        .Interior.Color = Array(vbRed, vbGreen)(Abs(.Characters.Text = "OK"))
        .Font.Color = Array(vbWhite, vbBlack)(Abs(.Characters.Text = "OK"))
    End With
End Sub

tu sais tout

sylvanu · 28 Septembre 2023

Bonjour Patrick,
Je m'étais basé sur la doc Microsft :

VB:

.TextFrame2.TextRange.Characters.Font.Fill.ForeColor.RGB = &H2020CC

Propriété ShapeRange.TextFrame2 (Project)

Rubrique de référence sur Office VBA

learn.microsoft.com

et je ne vois pas où cela peut poser problème.

job75 · 28 Septembre 2023

Bonjour,

Pourquoi pas un contrôle ActiveX :

VB:

Private Sub CommandButton1_Click()
Dim test As Boolean
With CommandButton1
    test = .Caption = "OK"
    .Caption = IIf(test, "PAS OK", "OK")
    .BackColor = IIf(test, vbGreen, vbRed)
    .ForeColor = IIf(test, vbBlack, vbWhite)
End With
End Sub

A+

patricktoulon · 28 Septembre 2023

re
@sylvanu
personne ne te dis que ça pose problème
je te donne une autre alternative qui peut te simplifier la vie c'est tout
il n'y a que les contours que je ne sais pas faire avec drawingobject
tiens reconnais que c'est plus simple quand même

VB:

Sub test()
    With ActiveSheet
        On Error Resume Next
        .Shapes("toto").Delete
        On Error GoTo 0

        .Shapes.AddShape(msoShapeRectangle, 50, 50, 200, 60).Name = "toto"

        With .DrawingObjects("toto")
            .Interior.Color = vbYellow                  'la couleur de fond  de ta shape
            .Characters.Text = "Bouton"                 'le text de ta shape
            .Font.Size = 36                             'le fontsize de ta shape
            .Font.Color = vbRed                         'fontcolor de ta shape
            .Font.Name = "algerian"                     'la police de caracteres
            .Font.Italic = True                         'font italic
            .Font.Bold = True                           'texte en gras
            .Font.Underline = xlUnderlineStyleSingle    'texte souligné
            .HorizontalAlignment = xlCenter             'alignement du texte horizontalement (xlLeft/xlCenter/xlRight)
            .VerticalAlignment = xlCenter               'alignement du text verticalement    (xlTop/xlCenter/xlBottom)

        End With
       
        With .Shapes("toto")
            .Line.Weight = 5
            .Line.ForeColor.RGB = vbRed
       End With
    End With
End Sub

XL 2016 Bouton avec 2 macro (Position 1 - Position initiale)

Mel976

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

Manipuler les shapes ( tuto pour débutants )

Pièces jointes

Staple1600

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Mel976

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

XL 2016 - Bouton avec 2 macro (Position 1 - Position initiale)

patricktoulon

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Propriété ShapeRange.TextFrame2 (Project)

job75

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

Discussions similaires