Microsoft 365 Double clique simple clic rectangle

mathjr74 · 29 Novembre 2020

Bonjour,

Je dispose d'une feuille sur laquelle j'ai 6 rectangles cliquables. Lorsque je clique sur l'un d'entres eux il change de couleur et se "remplit". J'ai juste un petit soucis lorsque je clique sur un rectangle de la Partie 1 et que je clique directement sur un rectangle étant dans la partie 2 ou inversement, certaines fois je dois double cliquer au lieu de faire un simple clique. Est ce que quelqu'un pourrait il m'aider à changer la macro pour ne faire qu'un simple clique à chaque fois svp.

En vous remerciant.

job75 · 29 Novembre 2020

Bonsoir mathjr74,

Pas essayé de comprendre pourquoi vous utilisez une macro si compliquée, essayez plutôt :

VB:

Sub RAPP_MWE_Rect_Colour()
Dim lig&, col%, s As Shape
With ActiveSheet.Shapes(Application.Caller)
    lig = .TopLeftCell.Row
    col = .TopLeftCell.Column
    For Each s In ActiveSheet.Shapes
        If s.TopLeftCell.Row = lig Then If s.TopLeftCell.Column <> col Then s.Fill.ForeColor.RGB = vbWhite 'RAZ
    Next
    Select Case Right(.TextFrame.Characters.Text, 1)
        Case 1: .Fill.ForeColor.RGB = IIf(.Fill.ForeColor.RGB = vbWhite, RGB(0, 166, 81), vbWhite)
        Case 2: .Fill.ForeColor.RGB = IIf(.Fill.ForeColor.RGB = vbWhite, RGB(250, 166, 26), vbWhite)
        Case 3: .Fill.ForeColor.RGB = IIf(.Fill.ForeColor.RGB = vbWhite, RGB(237, 29, 36), vbWhite)
    End Select
End With
End Sub

A+

job75 · 30 Novembre 2020

Bonjour le forum,

Si les noms des Shapes sont toujours numérotés avec un pas de 3 par ligne utiliser ce fichier (2) :

VB:

Sub RAPP_MWE_Rect_Colour()
Dim lig&, col%, s As Shape, n As Byte
With ActiveSheet.Shapes(Application.Caller)
    lig = .TopLeftCell.Row
    col = .TopLeftCell.Column
    For Each s In ActiveSheet.Shapes
        If s.TopLeftCell.Row = lig Then If s.TopLeftCell.Column <> col Then s.Fill.ForeColor.RGB = vbWhite 'RAZ
    Next
    n = (Val(Replace(.Name, "RAPP_MWE_Rect", "")) - 1) Mod 3 '0 ou 1 ou 2
    .Fill.ForeColor.RGB = IIf(.Fill.ForeColor.RGB = vbWhite, Array(RGB(0, 166, 81), RGB(250, 166, 26), RGB(237, 29, 36))(n), vbWhite)
End With
End Sub

A+

Microsoft 365 Double clique simple clic rectangle

mathjr74

XLDnaute Nouveau

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

Discussions similaires