Dropbutton
#1
Aspirant XLPages

Inscription: 23/12/2013
De 23290 st pierre de fursac

Messages: 23

Système d'exploitation:
pc
Version Excel utilisée:
2010
Posté le : 26-09-2014 22h22

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

 

Hors Ligne
Rapport   Haut 


Vous pouvez voir les sujets.
Vous ne pouvez pas débuter de nouveaux sujets.
Vous ne pouvez pas répondre aux contributions.
Vous ne pouvez pas éditer vos contributions.
Vous ne pouvez pas effacez vos contributions.
Vous ne pouvez pas ajouter de nouveaux sondages.
Vous ne pouvez pas voter en sondage.
Vous ne pouvez pas attacher des fichiers à vos contributions.
Vous ne pouvez pas poster sans approbation.

[Recherche avancée]


Qui consulte actuellement ce sujet ?   1 Utilisateur(s) anonymes