Microsoft 365 Liste de choix...

[WEIDER]

Bonjour à tous,

Je suis bloqué sur mon fichier Excel car je n'arrive pas à finaliser ma 'Liste de choix', pourriez-vous m'aider s'il vous plaît ?
D'avance un grand merci et tout est expliqué dans mon fichier joint.

Encore merci pour votre aide !

 

[job75]

Bonsoir WEIDER,

Ce que vous voulez faire n'est possible ni avec une liste de validation ni avec une ComboBox.

Dans le passé myDearFriend avait proposé une solution avec un contrôle WebBrowser mais sur Office 365 ça ne devrait pas fonctionner.

A+

 

[WEIDER]

Bonsoir job75, merci pour votre retour.
Existe t'il une toute autre façon (automatique) d'avoir à peux près le même résultat ?

 

[job75]

Bonjour WEIDER, le forum,

Existe t'il une toute autre façon (automatique) d'avoir à peux près le même résultat ?

Si c'est juste le résultat qui compte utilisez cette macro :

Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Intersect(Target, [J7:J37])
If Target Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each Target In Target 'si entrées multiples (copier-coller)
    Target.Font.Color = IIf(Target = "bas", vbRed, vbGreen)
    Target = IIf(Target = "bas", "ê", IIf(Target = "haut", "é", ""))
Next
Application.EnableEvents = True
End Sub

A+

 

[sylvanu]

Bonjour Weider, Job,

Existe t'il une toute autre façon (automatique) d'avoir à peux près le même résultat ?

On peut peut être utiliser les caractères étendus, comme cela :

La flèche vers le haut est obtenu avec ALT+24, celle vers le bas avec ALT+25

 

[Lolote83]

Bonjour à tous,
Ma version avec caractères spéciaux ( Touche Win + ; )
+ MFC pour le coloriage
@+ Lolote83

 

[WEIDER]

Mille merci pour tous vos retour, j'ai le choix à présent !
Je crois que je vais opter pour ta solution Job75, juste le temps pour moi de me rappeler comment transposer ça à mon document....

Merci encore à tous !

 

[Jean-Eric]

Bonjour,
Une proposition Windows 11 (émoji et plus...) et MFC.
Cdlt.

 

[job75]

Pour le fun une solution avec des Shapes :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim s As Shape, i As Byte
For Each s In Shapes
    If Not Intersect(s.TopLeftCell, [L7:L37]) Is Nothing Then s.Delete
Next
Set Target = Intersect(ActiveCell, [J7:J37])
If Target Is Nothing Then Exit Sub
Application.ScreenUpdating = False
For i = 1 To 2
    [P7].Cells(i).CopyPicture
    Me.Paste
    With Selection
        .Left = ActiveCell(1, 3).Left
        .Top = ActiveCell(i, 3).Top
        .OnAction = Me.CodeName & ".Macro"
        .Name = IIf(i = 1, "é", "ê")
    End With
    ActiveCell.Activate
Next
End Sub

Sub Macro()
If Not IsError(Application.Caller) Then ActiveCell = Application.Caller
End Sub

Mais une liste de validation est quand même plus simple !

Edit : j'ai mis une MFC sur J7:J37.