Microsoft 365 Evénement Click sur Listbox

CHALET53

XLDnaute Barbatruc
Bonjour à tous,
Lorsque l'on sélectionne un item, il apparaît un X à côté

Je souhaiterai pouvoir annuler ma sélection
et remettre à blanc la colonne où est inscrit le X
Il faudrait que préalablement cet item ait été désélectionné : Comment le Faire

Avec l'événement double click, pas de souci : je peux désélectionner
Je souhaiterai le faire avec un simple click

L'utilisation finale est destinée au pointage d'un compte bancaire
(annulation du pointage si erreur de ligne, par exemple)

D'avance Merci
 

Pièces jointes

  • USF Bis.xlsm
    27.2 KB · Affichages: 12

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

Votre macro corrigée: plus de gestion sur click mais sur mouseup.
VB:
Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    With ListBox1
         Rng = .ListIndex
        If Rng < 0 Then Exit Sub
        a = .List(Rng, 1)
        .List(Rng, 1) = IIf(.List(Rng, 1) = "", "X", "")
    End With
End Sub

Cordialement
 

Pièces jointes

  • USF Bis.xlsm
    24.9 KB · Affichages: 14

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour Chalet, bonjour le forum,

Essaie comme ça :

VB:
Private Sub ListBox1_Click()
With Me.ListBox1
    For I = 0 To .ListCount - 1
        .Column(1, I) = IIf(.Selected(I) = True, "X", "")
    Next I
End With
End Sub
 

CHALET53

XLDnaute Barbatruc
Re,
Merci pour vos propositions
Robert : J'avais utilisé ListBox1_MouseUp. Je pensais qu'il était possible de trouver une solution avec Listbox1_Click. Je vais rester avec la solution MouseUp
Roblochon : la première proposition ne convient pas car je peux avoir plusieurs lignes sélectionnées . Le pgm me supprime toutes les lignes sélectionnées
Je vais creuser la piste ListStyl et multiselect
Encore merci
Bonne soirée
 

patricktoulon

XLDnaute Barbatruc
re
bonjour
sinon tu a le mouse down avec bouton 1 ou 2
VB:
'Option Explicit
#If vba7 Then
    Private Declare PtrSafe Function GetDC& Lib "user32.dll" (ByVal hwnd&)
    Private Declare PtrSafe Function GetDeviceCaps& Lib "gdi32" (ByVal hDC&, ByVal nIndex&)
#Else
    Private Declare Function GetDC& Lib "user32.dll" (ByVal hwnd&)
    Private Declare Function GetDeviceCaps& Lib "gdi32" (ByVal hDC&, ByVal nIndex&)

#End If
Dim tb()


Private Sub ListBox1_Click()
    Rng = Me.ListBox1.ListIndex
    With ListBox1
         .List(Rng, 1) = "X"
       End With
End Sub

Private Sub ListBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 2 Then
        With ListBox1
            If .ListIndex >= 0 Then .List(.ListIndex, 1) = ""
        End With
    End If

End Sub
si tu click droit sur un item sélectionne ca enlève le "X" mais j'avoue que la solution de roblochon serait adequate meme en multiselect

demo3.gif
 

Robert

XLDnaute Barbatruc
Repose en paix
Re, bonjour Patrick,

Ce qui m'échappe à moi se sont les fichiers exemple qui n'en sont pas. La propriété Multiselect de ta Listbox1 est églae à 0 - fmMultiSelectSingle !...
Ça ne t'échappe pas ça ?!...
 

patricktoulon

XLDnaute Barbatruc
si le demandeur veux bien se donner la peine

VB:
'Option Explicit
#If vba7 Then
    Private Declare PtrSafe Function GetDC& Lib "user32.dll" (ByVal hwnd&)
    Private Declare PtrSafe Function GetDeviceCaps& Lib "gdi32" (ByVal hDC&, ByVal nIndex&)
#Else
    Private Declare Function GetDC& Lib "user32.dll" (ByVal hwnd&)
    Private Declare Function GetDeviceCaps& Lib "gdi32" (ByVal hDC&, ByVal nIndex&)

#End If

Private Sub UserForm_Initialize()
'Stop
    Dim S#, Y#, w#, h#, F As Worksheet
    ActiveWindow.Zoom = 100
    S = GetDeviceCaps(GetDC(0), 88) / 72
    Y = GetDeviceCaps(GetDC(0), 90) / 72


    With Me
        .StartUpPosition = 0
        .Left = ActiveWindow.PointsToScreenPixelsX(ActiveCell.Left * S) * 1 / S
        .Top = ActiveWindow.PointsToScreenPixelsY(ActiveCell.Top * Y) * 1 / Y
    End With
    
    Set F = Sheets("Feuil2")
    With ListBox1
        .ListStyle = fmListStyleOption
        .MultiSelect = fmMultiSelectMulti
        .List = F.Range("A5", F.Cells(Rows.Count, "A").End(xlUp)).Value
    End With

End Sub
 

CHALET53

XLDnaute Barbatruc
Robert
Mon fichier exemple est exactement la copie de mon fichier de référence. D'ailleurs, la copie pure et simple de la proposition de Roblochon fonctionne sur le fichier de destination.
Patrick dit : si le demandeur veux bien se donner la peine

Faudrait peut-être pas exagérer : Je suis inscrit depuis 2006 sur ce site. J'interviens souvent avec mes petits moyens (le nombre d'interventions peut en attester). Alors les leçons de morale !!!!!!!!!!!

Je vous l'accorde :Je ne suis pas un grand à côté des experts qui interviennent (dont les solutions m'impressionnent souvent)

Merci pour vos propositions qui, par ailleurs, m'intéressent.
Considérer que le dossier est clos
Merci pour vos conseils et solutions
Bonne soirée
 

patricktoulon

XLDnaute Barbatruc
bonjour chalet ca n'avait rien d'une critique ou lecon
mais je sais que on me dit de tout effacer dans mon module et de coller un autre code ca peut faire peur c'est dans ce sens que je l'ai dit
par ailleurs je ne sais pas si tu l'a remarquer j'ai ajouté la compatibilité des api avec le 32 bit ton fichier devrait fonctionner aussi bien sur 32 que 64 ca mange pas de pain et au cas ou ton fichier serait exploité sur diverses version d'excel et d'office