Discussion :

[Alasgard]

Bonjour, je viens demander votre aide car j'aimerai pouvoir sélectionner les 4 derniers items d'une listbox placée dans un userform.

Je souhaiterai que la sélection des 4 derniers se fasse automatiquement, en quelque sorte que l'on puisse activer un bouton, déclenchant l'userform sur une autre page (que l'on ne voit pas), et que tout se fasse en un clic en fait.

Dans ce userform, j'ai 2 boutons (Valider et Annuler(CommandButton2)) + une listbox multiselect.

Mon code vous paraitra certainement un peu spécial mais chaque item coché permet d'afficher une colonne dans un TCD.

J'ai regardé à de nombreux endroits, comme ici sur les forums pour trouver des infos mais je n'arrive pas à adapter les différents codes.


Voici mon code:

Partie Valider_Click:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Private Sub valider_click()
Dim X As Integer
 Dim i As Integer
 Dim sellist As Integer
 
Application.ScreenUpdating = False 'désactive la mise à jour de l'écran
 sellist = 0
    For i = 0 To ListBox1.ListCount - 1
       If ListBox1.Selected(i) = True Then
       sellist = 1
        End If
    Next i
 
If sellist = 1 Then
 
' on place tous à true
With Sheets("Calculs").PivotTables("PivotTable4").PivotFields("Date Opérations")
 
   For i = 0 To ListBox1.ListCount - 1
       If ListBox1.List(i) <> "" Then
 
              .PivotItems(CStr(ListBox1.List(i))).Visible = True
        End If
    Next i
 
For i = 0 To ListBox1.ListCount - 1
 
 If ListBox1.List(i) <> "" Then
 
 
        If ListBox1.Selected(i) = False Then
             .PivotItems(CStr(ListBox1.List(i))).Visible = False
        Else
             .PivotItems(CStr(ListBox1.List(i))).Visible = True
        End If
  End If
 Next i
 
 End With
  Call Calcul.Calculs_module1
 
 
 Else
 MsgBox ("Il faut choisir au moins une date.")
 End If
 
Unload Me
 
Application.ScreenUpdating = True 'active la mise à jour de l'écran
 
End Sub

Partie Annuler_CLick:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub CommandButton2_Click()
Dim i As Integer
For i = 0 To ListBox1.ListCount - 1
 
        If ListBox1.Selected(i) = True Then ListBox1.Selected(i) = False
 
    Next i
 
 Valider.Visible = False
 Unload Me
 
End Sub

Partie permettant de définir le nombre max d'items à sélectionner:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub ListBox1_Change()
'http://www.developpez.net/forums/d725485/logiciels/microsoft-office/excel/macros-vba-excel/limiter-nombre-selection-listbox/
' / Ucfoutu
  Static nb As Integer
  Dim choisi As Integer, max As Integer
  max = 6 ' tu mets ici la valeur que tu veux (nombre maxi de sélections autorisées)
  choisi = ListBox1.ListIndex
  If ListBox1.Selected(choisi) = False Then nb = nb - 1: Exit Sub
  If nb >= max Then ListBox1.Selected(choisi) = False
 
  nb = nb + 1
''''
 
 
  If nb > 0 Then
  Valider.Visible = True
  Else
  Valider.Visible = False
  End If
 
 
End Sub

Partie d'initialisation du Userform:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub UserForm_Initialize()
Dim MonDico As Object, Cellule As Range
 
Application.ScreenUpdating = False 'désactive la mise à jour de l'écranMsgBox ListBox1.List
 
'*** on note les analytiques présents ds feuil1
  Set MonDico = CreateObject("Scripting.Dictionary")
      For Each Cellule In Sheets("Prévisions").Range("A2:A65536")
      If Not MonDico.Exists(Cellule.Value) Then MonDico.Add Cellule.Value, Cellule.Value
      Next Cellule
        ListBox1.List = MonDico.Items
        MonDico.RemoveAll
 
 
End Sub

[parmi]

Plutôt qu'utiliser l'événement Change de ta listbox, utilise Click.
Lorsque tu charges ta listbox, il suffit de mettre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
    ListBox1.Selected(ListBox1.ListCount - 1) = True
    ListBox1.Selected(ListBox1.ListCount - 2) = True
    ListBox1.Selected(ListBox1.ListCount - 3) = True
    ListBox1.Selected(ListBox1.ListCount - 4) = True

[Alasgard]

Bonjour,
Merci de ta réponse rapide.
Si j'ai bien compris, au lieu d'avoir :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub ListBox1_Change()
'http://www.developpez.net/forums/d725485/logiciels/microsoft-office/excel/macros-vba-excel/limiter-nombre-selection-listbox/
' / Ucfoutu
  Static nb As Integer
  Dim choisi As Integer, max As Integer
  max = 6 ' tu mets ici la valeur que tu veux (nombre maxi de sélections autorisées)
  choisi = ListBox1.ListIndex
  If ListBox1.Selected(choisi) = False Then nb = nb - 1: Exit Sub
  If nb >= max Then ListBox1.Selected(choisi) = False
 
  nb = nb + 1
''''
 
 
  If nb > 0 Then
  Valider.Visible = True
  Else
  Valider.Visible = False
  End If
 
 
End Sub

Je devrais avoir:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub ListBox1_Click()
 ListBox1.Selected(ListBox1.ListCount - 1) = True
    ListBox1.Selected(ListBox1.ListCount - 2) = True
    ListBox1.Selected(ListBox1.ListCount - 3) = True
    ListBox1.Selected(ListBox1.ListCount - 4) = True
End Sub

J'ai tenté mais malheureusement lorsque j'active l'userform, j'ai le menu qui s'affiche sans rien de sélectionner et lorsque je veux valider, ça plante.


Ensuite, à tatons, je l'ai placé de la façon suivante:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Private Sub ListBox1_Change()
'http://www.developpez.net/forums/d725485/logiciels/microsoft-office/excel/macros-vba-excel/limiter-nombre-selection-listbox/
' / Ucfoutu
  Static nb As Integer
  Dim choisi As Integer, max As Integer
  max = 6 ' tu mets ici la valeur que tu veux (nombre maxi de sélections autorisées)
  choisi = ListBox1.ListIndex
 
 ListBox1.Selected(ListBox1.ListCount - 1) = True
    ListBox1.Selected(ListBox1.ListCount - 2) = True
    ListBox1.Selected(ListBox1.ListCount - 3) = True
    ListBox1.Selected(ListBox1.ListCount - 4) = True
''''
 
 
 
  Valider.Visible = True
 
 
 
End Sub

Et lorsque je lance l'userform, ms données sont bien sélectionnées mais impossible de valider (D'ailleurs je souhaiterai ne pas avoir à le faire ) et ça plante.

Si tu pouvais me guider pour le placer d'une meilleure façon, je t'en serai très reconnaissant .

[parmi]

Non, mets tout ce que tu as mis dans Listbox1_Change dans Listbox1_Click et efface la Sub Listbox1_Change
Ce que je t'ai donné, tu le mets après avoir chargé ta listbox.

[Alasgard]

Parfait, merci (pour la rapidité et l'efficacité)

Mais ai-je la possibilité de "simuler" le clic sur Valider?
Car là avec ton aide, je réussis à cocher les cases voulues automatiquement mais j'aimerai pouvoir faire la validation par la suite en automatique également..

[parmi]

Je ne saisis pas ce que tu entends par simuler le click pour "valider" automatiquement.
Tu sembles avoir un bouton Valider. Tu peux soit appeler directement l'événement Click de ce bouton ou créer une Sub de validation.

[casefayere]

Bonsoir,

Je ne sais pas si j'arrive à suivre mais quand Alasgard, tu écris

De cette façon, il n'y a en effet plus de conflit mais lorsque j'appelle la procédure Valider, elle ne se réalise pas..

ce code pour la procédure ne suffirait pas, à tout hasard !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub valider_click()
Dim i As Integer
 
Application.ScreenUpdating = False 'désactive la mise à jour de l'écran
For i = 0 To ListBox1.ListCount - 1
  With Sheets("Calculs").PivotTables("PivotTable4").PivotFields("Date Opérations")
    If ListBox1.Selected(i) = True Then
      .PivotItems(CStr(ListBox1.List(i))).Visible = True
    Else
      .PivotItems(CStr(ListBox1.List(i))).Visible = False
    End If
  End With
Next i
Call Calcul.Calculs_module1
Unload Me
Application.ScreenUpdating = True 'active la mise à jour de l'écran
 
End Sub

Je n'ai, bien sur pas pu tester, n'ayant aucun fichier modèle sous la main.

Pour le reste, je te laisse continuer de regarder le problème avec Parmi.

[Alasgard]

Avec to n code, un message d'erreur apparait:
"Impossible de lire la propriété PivotItems de la classe PivotFields"
Mais merci d'avoir essayé

Désolé pour le fait de ne pas avoir de modèle mais je n'ai pas pu en créer un encore et je ne peux pas passer le fichier que j'ai pour des raisons de confidentialité ..

[casefayere]

Bonjour,

Avec to n code, un message d'erreur apparait:
"Impossible de lire la propriété PivotItems de la classe PivotFields"

et je me suis contenté de reprendre ta formulation

[Philippe Tulliez]

Bonjour,

Avec to n code, un message d'erreur apparait:
"Impossible de lire la propriété PivotItems de la classe PivotFields"
Mais merci d'avoir essayé

D'après moi la syntaxe proposée par Dominique est correcte.
Le problème vient vraisemblablement du fait que tu as recréé un TCD et que sont nom n'est plus "PivotTable4"
A vérifier.
A vérifier également la valeur de ListBox1.List(i)

[Alasgard]

Il est certain que je n'ai pas recréé de TCD, c'est toujours le même qui subit des "refresh".
Mais merci encore pour vos contributions .

Je viens de regarder lorsque je lance mon code de cette façon:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub UserForm_Initialize()
Dim MonDico As Object, Cellule As Range
 
Application.ScreenUpdating = False 'désactive la mise à jour de l'écranMsgBox ListBox1.List
 
'*** on note les analytiques présents ds feuil1
  Set MonDico = CreateObject("Scripting.Dictionary")
      For Each Cellule In Sheets("Planifiées").Range("A2:A65536")
      If Not MonDico.Exists(Cellule.Value) Then MonDico.Add Cellule.Value, Cellule.Value
      Next Cellule
        ListBox1.List = MonDico.Items
        MonDico.RemoveAll
   ListBox1.Selected(ListBox1.ListCount - 2) = True
 
End Sub

Et qu'ensuite je clique avec ma souris sur Valider, cela fonctionne sans aucun souci.

Après lorsque j'essaie d'une autre façon où je fais appel à valider_click:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
ListBox1.Selected(ListBox1.ListCount - 2) = True
    Call valider_click
End Sub

Le valider_click a bien lieu, il y a juste un plantage (celui qu'on a vu précédemment) qui apparait lorsque l'on fait le End SUb de l'Userform_Initialize ..
Peut être qu'il faudrait le placer ailleurs mais je vois pas trop où ce serait possible.

Ou alors je vais regarder s'il est possible de déplacer le curseur sur le bouton de validation et de simuler un clic.

[Alasgard]

Comme je vous l'avais dit, l'erreur arrivait une fois que la procédure appelée avait lieu et qu'on retournait sur le userform_initialize.
J'ai regardé un peu de partout sur le net et j'ai cherché à bloquer ceci. Pour se faire, j'ai placé un "End" avant mon End Sub de Valider_CLick.

D'après l'aide MSDN:

End: Terminates execution immediately. Never required by itself but may be placed anywhere in a procedure to end code execution, close files opened with the Open statement and to clear variables.

Et en effet, grâce à ceci, tout fonctionne .

Merci à vous pour tout ce que vous avez fait!

PS: Désolé du triple-post