Rapport de message :*
 

Dropbutton

Titre du sujet : Dropbutton
par francoislc le 26/09/2014 22:22:00

Bonsoir au forum,

sur cette macro j'ai 4 dropbuttons qui permettent ensuite de choisir dans une liste déroulante puis une deuxième liste

ce que je souhaite, histoire de gagner un clic en général, vu que j'utilise essentiellement un seul drop,

c'est qu'il soit précoché.

Si dans ses propriétés je mets la valeur true, alors la liste n'apparait pas, il faut que je le déclic puis le reclic pour que cela fonctionne.

quelqu'un aurait-il une solution, simple sachant que ce n'est pas une catastrophe non plus.

je ne vous ai mis qu'un code agissant après le choix du drop, les autres sont identiques

cordialement

voici le code :

Private Sub sdpt_Change()

End Sub

Private Sub smeec_Click() 'Liste PS MEEC
Dim i As Integer
Dim nb1 As Integer
Dim nb2 As Integer

ps_dpt.sps.Clear
ps_dpt.sdpt.Clear
                        'recherche dernière cellule renseignée
nb1 = Worksheets("Données").Range("A1000").End(xlUp).Row
nb2 = Worksheets("Données").Range("O1000").End(xlUp).Row
nb1 = nb1 + 1
                     'cherche et renseigne la liste des postes sources de la MEEC
For i = nb1 To nb2
If (Worksheets("Données").Range("O" & i)) = "MEEC" Then
sps = (Worksheets("Données").Range("S" & i))
                      'gestion des doublons
If sps.ListIndex = -1 Then sps.AddItem (Worksheets("Données").Range("S" & i))
End If
Next i
ps_dpt.sps = ""
End Sub





Private Sub UserForm_Click()

End Sub

Private Sub validpsdpt_Click()
ActiveSheet.Unprotect Password = "benevent"
'renseignement de la cellule du ps
Range("Z1") = ps_dpt.sps.Value
'renseignement de la cellule du dpt
Range("Z2") = ps_dpt.sdpt.Value
Unload ps_dpt
End Sub
Private Sub sps_DropButtonClick()
Dim i As Integer
Dim nb1 As Integer
Dim nb2 As Integer
Dim maille As String
        If ps_dpt.smeec = True Then
        maille = "MEEC"
        End If
        If ps_dpt.saehv = True Then
        maille = "AEHV"
        End If
        If ps_dpt.sarc = True Then
        maille = "ARC"
        End If
        If ps_dpt.sarco = True Then
        maille = "ARCO"
        End If
        

                        'recherche dernière cellule renseignée
nb1 = Worksheets("Données").Range("A1000").End(xlUp).Row
nb2 = Worksheets("Données").Range("O1000").End(xlUp).Row
nb1 = nb1 + 1
                     'cherche et renseigne la liste des départs par PS sélectionné
For i = nb1 To nb2
           If ps_dpt.sps.Value = Worksheets("Données").Range("S" & i) And maille = Worksheets("Données").Range("O" & i) Then
            ps_dpt.sdpt.AddItem Worksheets("Données").Range("Q" & i)
            End If
Next i
End Sub