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

[Mel976]

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]

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

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]

Bonsoir le fil

Une autre syntaxe pour les IIFophiles

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]

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

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]

@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]

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

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]

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

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]

mais là partie du code ci-dessous bloque:

Dans ma PJ ?
Cela devrait donner ça :

 

[patricktoulon]

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]

re
la voici avec le font color

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

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]

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

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

Bonjour,

Pourquoi pas un contrôle ActiveX :

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]

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

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