Dropbutton | ||
---|---|---|
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
|
|
|
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.
Qui consulte actuellement ce sujet ?
1 Utilisateur(s) anonymes