Coincé sur formulaire vba

Version imprimable

10/05/2015, 10h58
stephb084

1 pièce(s) jointe(s)

Coincé sur formulaire vba

Bonjour a tous,

J'ai crée un formulaire que j'ai encodé en vba a l'aide d'internet et de mes propres connaissances. Mais aujourd'hui je suis coincé ! Je vous explique le fonctionnement de ce formulaire : Dés que l'on ouvre le fichier, nous voyons directement le formulaire s'afficher avec la 1er USF. Mon problème ce trouve dans l'USF du bouton "2eme sauvegarde". Lorsque l'on sélectionne le nom du client dans la combobox1 cela nous affiche dessous dans la listbox1 la liste des disques durs qui ont étaient déclarés en achat dans la 1er USF (Pas de soucis c'est ce que je voulais) Maintenant, je voudrais faire en sorte, que lorsque l'un des disques a déjà était déclaré en "2eme sauvegarde", qu'il n'apparaisse plus dans la listbox1 et en même temps je ne veux pas que cela me modifie les données récupérées dans mon tableur. Pour info la "2eme sauvegarde" correspond a la USF4.

Pour avoir accès au fichier excel, il suffit de cliquer sur la croix pour faire apparaître le tableur.

Pièce jointe 177341

Merci d'avance pour votre aide.
10/05/2015, 11h00
SfJ5Rpw8

Bonjour,

comment rempli tu tes combobox ?
10/05/2015, 12h11
stephb084

Bonjour bbil,

Tout d'abord merci d'avoir pris en compte ma demande.

Ensuite, pour répondre a ta question :

La combobox1 (Celle concernée par l'USF4) récupère toutes données des cellules de la colonne A du tableur (Qui corresponde au nom des différents clients)
10/05/2015, 12h39
SfJ5Rpw8

et comment elle récupère cela ?? avec une pelle ? du code ? je ne vais pas ouvrir ton fichier pour cela ... essai de comprendre un minimum le fonctionnement de ton code...

Fichier joint dans vos discussions

Autant pour moi, je n'avais compris ou tu voulais en venir !!

Voici le code qui récupère les infos de la combobox1 sans les doublons :

Code:

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
'vide la combobox1
ComboBox1.Clear
j = 0
i = 0
k = 0
temp = 0
 
'vide la combobox1
ComboBox1.Clear
 
With Sheets("Borne")
    For j = 2 To .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
'remplit la combobox
        ComboBox1 = .Range("A" & j)
'sans doublons......
    If ComboBox1.ListIndex = -1 Then ComboBox1.AddItem .Range("A" & j)
    Next j
End With
'trie la combobox
With ComboBox1
    For i = 0 To .ListCount - 1
      For k = 0 To .ListCount - 1
        If .List(i) < .List(k) Then
          temp = .List(i)
          .List(i) = .List(k)
          .List(k) = temp
        End If
      Next k
    Next i
    .ListIndex = -1
End With
 
ListBox1.Clear
 
End Sub

Bonjour le fil, bonjour le forum,

Ton fichier en pièce jointe ayant été supprimé, c'est la règle ici, j'ai beaucoup de mal à comprendre tes explications malgré le code fourni.
Ci-dessous une modification de ton code qui ne répond pas à ton problème mais qui devrait accélérer son exécution (non testé) :

Code:

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
Dim B As Worksheet 'déclare la variable B (onglet Borne)
Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim I As Integer 'déclare la variable I (Incrément)
 
ComboBox1.Clear 'vide la ComboBox1
Set B = Sheets("Borne") 'définit l'onglet B
TC = B.Range("A1").CurrentRegion 'définit le tableau de cellules TC
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TC, 1) 'boucles sur toutes les lignes I du tableau de cellules TC (en partant de la seconde)
    D(TC(I, 1)) = "" 'alimente le dictionnaire D avec la valeur en colonne 1 de TC
Next I 'prochaine ligne de la boucle
TMP = D.keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon
Call tri(TMP, LBound(TMP, 1), UBound(TMP, 1)) 'lance la macro de tri du tableau TMP
Me.ComboBox1.List = TMP 'alimente la Combobox1 avec la liste TMP triée et sans doublon
ListBox1.Clear 'vide la ListBox1
End Sub
 
'tiré du site de Jacques BOISGONTIER : http://boisgontierjacques.free.fr/pages_site/Dictionnaire.htm
Sub tri(a As Variant, gauc As Integer, droi As Integer) ' Quick sort
Dim ref As Variant
Dim g As Integer
Dim d As Integer
Dim temp As Variant
 
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): D = D - 1: Loop
    If g <= d Then
        temp = a(g): a(g) = a(d): a(d) = temp
        g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub

10/05/2015, 16h24
SfJ5Rpw8

Bon il vas falloir que tu fasse l'effort de décrire les données stockées dans ton fichier ... comment "marque" tu un PC dont la 2° sauvegarde à été effectuéer ??

sert toi de ce marquage pour conditionner ta ligne d'insertion dans l la combo box :

Code:

If ComboBox1.ListIndex = -1 Then ComboBox1.AddItem .Range("A" & j)

1 pièce(s) jointe(s)

Désolé si j'ai du mal a suivre !

J'avais mis en PJ mon fichier pour vous faciliter les choses, mais apparemment on n'a pas le droit !

Alors pour rentrer dans les détails voici l’intégralité du code qui gère le USF4 (USF qui sert a "marquer" un pc qui a déjà fait une 2eme sauvegarde)

Code:

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
'code qui récupére les nom des clients sans les doublons
 
'vide la combobox1
ComboBox1.Clear
j = 0
i = 0
k = 0
temp = 0
 
'vide la combobox1
ComboBox1.Clear
 
With Sheets("Borne")
    For j = 2 To .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
'remplit la combobox
        ComboBox1 = .Range("A" & j)
'sans doublons......
    If ComboBox1.ListIndex = -1 Then ComboBox1.AddItem .Range("A" & j)
    Next j
End With
'trie la combobox
With ComboBox1
    For i = 0 To .ListCount - 1
      For k = 0 To .ListCount - 1
        If .List(i) < .List(k) Then
          temp = .List(i)
          .List(i) = .List(k)
          .List(k) = temp
        End If
      Next k
    Next i
    .ListIndex = -1
End With
 
ListBox1.Clear
 
End Sub
 
 
Private Sub ComboBox1_Click()
 
'-----------------------Remplir la ListBox (N° de DD) sans doublons---------
 
With Sheets("Borne")
    Dim Cell As Range
    Dim Unique As New Collection
    Dim Valeur As Range
    Dim I As Integer
    ListBox1.Clear
 
'Récupère la dernière ligne non vide dans la colonne B
    I = Sheets("Borne").Range("B65536").End(xlUp).Row
 
    On Error Resume Next
'boucle sur les cellules de la colonne B
 
    For Each Cell In Sheets("Borne").Range("B2:B" & I)
'Stock les données dans une collection n'accepte que des valeurs uniques et permet donc de filtrer facilement les doublons
 
 
    ' Si la valeur de la colonne A est identique au Nom du client
    If Cell.Offset(0, -1) = Me.ComboBox1 Then
      Unique.Add Cell, CStr(Cell)
    End If
    Next Cell
 
    'Boucle sur le contenu de la collection pour alimenter la ListBox
    For Each Valeur In Unique
        Me.ListBox1.AddItem Valeur
    Next Valeur
 
End With
 
End Sub
 
 
'----------------------------- ListBox Afficher liste des DD par client selectionné -------------------------------------------
 
Private Sub ListBox1_Click()
 
'dès que l'on clique sur le nom d'une personne, on affiche dans le formulaire les données correspondantes
 
Dim I As Integer
I = 0
 
 
With Sheets("Borne")
For I = 1 To Sheets("Borne").Range("B65536").End(xlUp).Row
If Sheets("Borne").Range("B" & I).Value = ListBox1.Value Then
             TextBox1.Value = Sheets("Borne").Range("C" & I).Value
             TextBox3.Value = Sheets("Borne").Range("D" & I).Value
             TextBox4.Value = Sheets("Borne").Range("E" & I).Value
 
End If
Next I
End With
End Sub
 
  '----------------------------Bouton:Valider--------------------------------
 
   Private Sub commandbutton1_click()
 
Dim I As Integer
I = 0
 
  With Sheets("Borne")
For I = 1 To Sheets("Borne").Range("B65536").End(xlUp).Row
If Sheets("Borne").Range("B" & I).Value = ListBox1.Value Then
             Range("J" & I).Value = Clock.Value
             Range("K" & I).Value = Clock1.Value
      End If
      Next I
End With
 
    Unload Me
    UserForm2.Show 'Ouvre la fenetre de "choix des tâches"
 
End Sub

J'ai essayé de mettre des détails en commentaire dans le code, est-ce que cela conviens ?

Alors pour être encore plus précis dans ma demande et pour vous aider a visualiser mon tableau voici :

Pièce jointe 177373

Donc mon but étant d'afficher dans la listbox de mon formulaire USF4 les données de la colonne B correspondant au client figurant dans la combobox, mais si les colonnes J et K contiennent déjà des données en face du client en question il ne faut pas afficher la cellule de la colonne B.

J'ai du mal a être très clair !

Merci pour votre aide

10/05/2015, 22h09
SfJ5Rpw8

Et bien il suffit de verifier le contenu de ta colone J lorsque tu rempli ton combobox1..
10/05/2015, 22h23
stephb084

C'est bien la que je bloque, je n'arrive pas a écrire le code pour faire ça.
10/05/2015, 22h40
SfJ5Rpw8

Dans mon precèdent message je t'ais montrè la ligne a modifier .. rajoute une condition avec un "and"

Bonjour a tous,

Je patauge toujours :) J'aimerais que la colonne J soit vérifier et doit être vide afin de remplir les N° de DD dans la listbox.

A quel endroit dans mon code et comment puis-je écrire "Si la cellule J est vide dans ce cas tu fait apparaître le N° DD dans la listbox sinon tu ne le fait pas apparaître"

Voici la partie du code qui récupère les N° DD par client pour les afficher dans la listbox :

Code:

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
With Sheets("Borne")
    Dim Cell As Range
    Dim Unique As New Collection
    Dim Valeur As Range
    Dim I As Integer
    ListBox1.Clear
 
'Récupère la dernière ligne non vide dans la colonne B
    I = Sheets("Borne").Range("B65536").End(xlUp).Row
 
    On Error Resume Next
'boucle sur les cellules de la colonne B
 
    For Each Cell In Sheets("Borne").Range("B2:B" & I)
'Stock les données dans une collection n'accepte que des valeurs uniques et permet donc de filtrer facilement les doublons
 
 
    ' Si la valeur de la colonne A est identique
    If Cell.Offset(0, -1) = Me.ComboBox1 Then
      Unique.Add Cell, CStr(Cell)
 
     End If
    Next Cell
 
    'Boucle sur le contenu de la collection pour alimenter la ListBox
    For Each Valeur In Unique
        Me.ListBox1.AddItem Valeur
    Next Valeur
 
End With
 
End Sub

Bonsoir,

j'ai encore un problème pour l'organisation de ton tableau, ta colonne B est bien unique ? tu ne peu pas retrouver un même disque sur plusieurs lignes ?

du coup je comprends pas trop pourquoi tu as rajouté du code pour rendre "unique" les valeurs dans ta collection ...?

mais bon tiens à tester :
Code:

1 2 3 4 5 6 For Each Cell In Sheets("Borne").Range("B2:B" & I) ' Si la valeur de la colonne A est identique ET la colonne J vide ' J-B = 8 soit valeur dans colonne J ) cell.Offset(0,8) If Cell.Offset(0, -1) = Me.ComboBox1 AND CELL.OFFSET(0,8) ="" Then Unique.Add Cell, CStr(Cell) End If

Bonsoir,

Il ne ce passe rien avec ce code, je l'ai peut-être mal placé :

Code:

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
With Sheets("Borne")
    Dim Cell As Range
    Dim Unique As New Collection
    Dim Valeur As Range
    Dim I As Integer
    ListBox1.Clear
 
'Récupère la dernière ligne non vide dans la colonne B
    I = Sheets("Borne").Range("B65536").End(xlUp).Row
 
    On Error Resume Next
'boucle sur les cellules de la colonne B
 
   For Each Cell In Sheets("Borne").Range("B2:B" & I)
   ' Si la valeur de la colonne A est identique ET la colonne J vide  ' J-B = 8  soit valeur dans colonne J ) cell.Offset(0,8)
    If Cell.Offset(0, -1) = Me.ComboBox1 And Cell.Offset(0, 8) = "" Then
      Unique.Add Cell, CStr(Cell)
 
     End If
 
   'Next Cell
 
    'Boucle sur le contenu de la collection pour alimenter la ListBox
    For Each Valeur In Unique
        Me.ListBox1.AddItem Valeur
    Next Valeur
 
 
End With
 
End Sub

11/05/2015, 21h49
clementmarcotte

Bonjour,

Citation:

Envoyé par stephb084

Bonsoir,

Il ne ce passe rien avec ce code, je l'ai peut-être mal placé :

Mets ta ligne:

Code:

on error resume next

en commentaire. Avec un peu de chance , il va planter sur la bonne ligne et te donner un message d'erreur.
11/05/2015, 22h22
SfJ5Rpw8

Re,

et pourquoi la ligne

Code:

Next Cell

est passée en commentaire ?

Bonjour,

Mon problème est résolu.
Merci pour votre aide et vos astuces cela m'a permis d'écrire le bon code.

Pour info voici le code final :

Code:

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
With Sheets("Borne")
    Dim Cell As Range
    Dim Unique As New Collection
    Dim Valeur As Range
    Dim I As Integer
    ListBox1.Clear
 
'Récupère la dernière ligne non vide dans la colonne B
    I = Sheets("Borne").Range("B65536").End(xlUp).Row
 
    On Error Resume Next
'boucle sur les cellules de la colonne B
 
    ' Si la valeur de la colonne A est identique
    For Each Cell In Sheets("Borne").Range("B2:B" & I)
   ' Si la valeur de la colonne A est identique ET la colonne J vide  ' J-B = 8  soit valeur dans colonne J ) cell.Offset(0,8)
    If Cell.Offset(0, -1) = Me.ComboBox1 And Cell.Offset(0, 8) = "" Then
      Unique.Add Cell, CStr(Cell)
 
    End If
    Next Cell
 
    'Boucle sur le contenu de la collection pour alimenter la ListBox
    For Each Valeur In Unique
        Me.ListBox1.AddItem Valeur
    Next Valeur
 
End With
 
End Sub

Je reviendrais chercher des réponses a mes questions trés vite.
Encore merci

12/05/2015, 17h07
SfJ5Rpw8

Citation:

Envoyé par stephb084

...
Mon problème est résolu....

il y as un bouton :resolu: en dessous du dernier message de la discussion pour signaler cela ;)