Remplir listbox ouverture USF

Version imprimable

Voir 40 message(s) de cette discussion en une page

29/01/2011, 20h30
mercatog

J'ai refais tout le code pour ton userform appartenant au calsseurB

Code:

.Range("B1:B" & LastLig).AutoFilter field:=1, Criteria1:=Tblo, Operator:=xlFilterValues

Tblo est une variable tableau dans laquelle on récupère tous les noms sélectionnés à partir de ListBox2
La ligne précédente permet de filtrer la colonne B de Feuil1 de ton ClasseurB et de copier les lignes résultantes du filtre dans une feuille Sh créée provisoirement. Ensuite, on efface toute notre feuil1 et on recopie les données à partir de la feuille Sh, qu'on supprime par la suite.
C'est la gymnastique.

Essaies de recopier tout le code tel quel sur un nouveau fichier test.
29/01/2011, 23h21
samimi94

Bonsoir Mercatog,

Me voilà de retour.

Après avoir mis ton nouveau USF j'ai un message d'erreur :

erreur d'execution 1004
La méthode autofilter de la classe Range a échoué

Vois-tu ce qui peux générer ce message ?

Le pas à pas met l'erreur sur la ligne de code que tu as indiqué dans ton dernier message.
29/01/2011, 23h34
samimi94

Mercatog,

Si cela peut aider à y voir plus clair , je vois que malgré l'erreur une Feuil1 vierge est rajoutée dans mon classeur A

Mercatog,

Je continue de travailler avec tes bouts de code en essayant de les comprendre tant bien que mal.

Malgré toutes les erreurs et le fait que le code ne va pas au bout, je m'apercois qu'avec les codes que tu m'as fournis, ceux-ci modifient mon fichier de données du classeur A.

Les codes qui semblent agir sur le classeur A (je crois mais je n'en suis pas sure) sont :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Private Sub UserForm_Initialize() Dim LastLig As Long, i As Long Dim MonDico As Object With ThisWorkbook.Worksheets("Feuil3") LastLig = .Cells(.Rows.Count, "B").End(xlUp).Row .Range("B1:B" & LastLig).Sort Key1:=.Range("B2"), Order1:=xlAscending, Header:=xlYes Set MonDico = CreateObject("scripting.dictionary") For i = 2 To LastLig If Trim(.Range("B" & i).Value) <> "" Then MonDico(UCase(.Range("B" & i).Value)) = 1 Next i Me.ListBox1.List = MonDico.keys Set MonDico = Nothing End With End Sub
et/ou (en fait j'ai essayé les deux)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Option Explicit Private Sub UserForm_Initialize() Dim LastLig As Long, i As Long Dim MonDico As Object With ThisWorkbook.Worksheets("Feuil3") LastLig = .Cells(.Rows.Count, "B2").End(xlUp).Row .Range("B1:B" & LastLig).Sort Key1:=.Range("B2"), Order1:=xlAscending, Header:=xlYes Set MonDico = CreateObject("scripting.dictionary") For i = 2 To LastLig If Trim(.Range("B" & i).Value) <> "" Then MonDico(UCase(.Range("B" & i).Value)) = 1 Next i Me.ListBox1.List = MonDico.keys Set MonDico = Nothing End With End Sub
En fait dans mon classeur A ma première ligne correspond aux intitulés de colonnes.

Quand le USF s'execute à l'ouverture du classeur B (malgré les erreurs signalées dans mes posts précédents), je m'aperçois que la feuil3 de mon classeur A a subit une modification.
Le 1er nom de contact (B2) se retrouve en B1 à la place de l'intitulé de la colonne et tous les autres contacts remontent d'une ligne.

Que dois je modifier dans le code pour ne pas modifier mon fichier de données du classeur A ?

Merci beaucoup et bonne soirée.
Surtout n'hésites pas si tu me trouves trop brouillon.

30/01/2011, 01h56
samimi94

Alors, a force de bidouille j'ai corrigé je ne sais comment le problème qui modifié mon classeur A en remplacant (du moins je pense car j'ai pas mal modifié les infos :roll:) dans le code :

Code:

With ThisWorkbook.Worksheets

Que j'ai remplacé par :

Code:

With Sheets("Feuil1")

Cependant il me reste toujours une erreur sur ce bout de code :

Code:

.Range("A1:X" & LastLig).SpecialCells(xlCellTypeVisible).Copy ThisWorkbook.Sheets("Feuil2").Range("A1")

Toujours cette fameuse erreur d'execution code 9. Malgré cette erreur il y a tout de même du positif, car j'obtiens bien les contacts sélectionnés en listbox2 dans mon classeur B.

Si tu as une idée, je suis prenante.
Désolée pour tous ces posts, mais je préfère te tenir informé au fur et à mesure afin que tu ne t'embêtes pas avec mes codes quand le probème n'y est plus.

Merci encore.
30/01/2011, 02h26
samimi94

RESOLU

Mercatog,

Enfin une bonne nouvelle, tout fonctionne à merveille.

A force de bidouille et en tentant de comprendre tous ces bouts de codes que tu m'as fourni, j'ai enfin réussi à l'adapter à mon fichier.

En fait j'avais encore oublié de modifier des :

ThisWorkbook.Worksheets

et en mettant des Sheets à la place, la macro n'a plus buguée et tout est OK.

Un grand MERCI.

Je vais enfin pouvoir aller me coucher ;)

Bonne continuation

Bon, pour formaliser les choses, je ne travaille jamais avec des feuilles sans leur affecter leur classeur père si le code fait intervenir plusieurs classeurs.
J'ai réalisé mon test comme ceci:
1. Disposition des classeurs:
ClasseurA: Contient Feuil1, Feuil2 et Feuil3
ClasseurB: Contient Feuil1 et UserForm2
2. Codes
2.1 Sur Feuil1 de ClasseurA, j'ai mis un CommandButon qui permet d'ouvrir ClasseurB avec le code suivant:

Code:

1
2
3
Private Sub CommandButton1_Click()
Workbooks.Open "C:\Users\user\Desktop\USF.xlsm" 'ClasseurB
End Sub

2.2 Sur Open de ClasseurB, j'ai le code suivant:

Code:

1
2
3
Private Sub Workbook_Open()
UserForm2.Show
End Sub

2.3 Les codes sur userform2 sont les suivants:

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
'Permet de remplir ListBox1 sans doublons des données émanants de la colonne B de Feuil1 du ClasseurB
Private Sub UserForm_Initialize()
Dim LastLig As Long, i As Long
Dim MonDico As Object
 
With ThisWorkbook.Worksheets("Feuil1") 'Correspond à Feuil1 de ClasseurB
   LastLig = .Cells(.Rows.Count, "B").End(xlUp).Row
   .Range("B1:B" & LastLig).Sort Key1:=.Range("B2"), Order1:=xlAscending, Header:=xlYes
   Set MonDico = CreateObject("scripting.dictionary")
   For i = 2 To LastLig
      If Trim(.Range("B" & i).Value) <> "" Then MonDico(UCase(.Range("B" & i).Value)) = 1
   Next i
   Me.ListBox1.List = MonDico.keys
   Set MonDico = Nothing
End With
End Sub
'Transférer items de ListBox1 vers ListBox2
Private Sub Transfert_Click()
With Me.ListBox1
   If .ListIndex > -1 Then
      Me.ListBox2.AddItem .List(.ListIndex)
      .RemoveItem .ListIndex
      .ListIndex = -1
   End If
End With
End Sub
'------------------------------------Valider
Private Sub Valider_Click()
Dim Sh As Worksheet
Dim LastLig As Long
Dim i As Integer
Dim Tblo() As String
 
Application.ScreenUpdating = False
If Me.ListBox2.ListCount > 0 Then
   ReDim Tblo(1 To Me.ListBox2.ListCount)
   For i = 0 To Me.ListBox2.ListCount - 1
      Tblo(i + 1) = Me.ListBox2.List(i)
   Next i
   Set Sh = ThisWorkbook.Worksheets.Add   'Ajoute une feuille tampon sur classeurB
   With ThisWorkbook.Worksheets("Feuil1") 'Correspond à Feuil1 de ClasseurB
      .AutoFilterMode = False
      LastLig = .Cells(.Rows.Count, "B").End(xlUp).Row
      .Range("B1:B" & LastLig).AutoFilter field:=1, Criteria1:=Tblo, Operator:=xlFilterValues
      .Range("A1:X" & LastLig).SpecialCells(xlCellTypeVisible).Copy Sh.Range("A1")
      .AutoFilterMode = False
      .UsedRange.ClearContents
      Sh.UsedRange.Cut .Range("A1")
   End With
   Application.DisplayAlerts = False
   Sh.Delete
   Application.DisplayAlerts = True
   Set Sh = Nothing
   Unload Me
   ThisWorkbook.Close True
Else
   MsgBox "Aucune donnée à traiter"
End If
End Sub

Les données du ClasseurA ne sont à aucun moment affectés par les codes textuellement reportés ci-haut.

30/01/2011, 14h22
samimi94
Bonjour Mercatog,

Bien que tout fonctionne comme je le souhaite, j'aimerai tester ta nouvelle organisation mais je ne saisi pas tout, du moins je ne comprends pas ou mettre tous les éléments.

En cliquant sur le bouton du classeur A j'execute un nouveau classeur, par conséquence je ne saisi pas à quel endroit je dois mettre :
Code:

1 2 3 Private Sub Workbook_Open() UserForm2.Show End Sub
Dans un module du classeur A ?
Qu'est ce qu'un fichier xlsm ?
Les codes du USF sont toujours dans le classeur A ?

Je ne maitrise pas du tout le VBA mais tout ce que l'on peut faire avec attise ma curiosité.

Merci.
30/01/2011, 14h30
mercatog
Pourtant j'avais détaillé dans ma réponse d'aujourd'hui
Nous avions convenu que tu ouvre manuellement ton classeurA
à partir de ClasseurA tu ouvre par macro le ClasseurB
dans ton classeurA tu as un bouton qui permet d'ouvrir le ClasseurB comme ceci
Code:

1 2 3 Private Sub CommandButton1_Click() Workbooks.Open "C:\Users\user\Desktop\LeNomDeTonClasseurB.xls" 'ClasseurB End Sub
le .xlsm c'est parc que je teste avec Excel2007
Dans ton ClasseurB, tu as affirmé que l'userform2 se lance à l'ouverture de ce calsseur. Donc je déduis que tu as mis ce code dans le module ThisWorkbook
Code:

1 2 3 4 'Code à mettre dans le module ThisWorkbook de classeurB Private Sub Workbook_Open() UserForm2.Show End Sub
c'est à dire, à l'ouverture de ClasseurB, userform2 se lance automatiquement

Userform2 est dans le ClasseurB, donc ses codes sont sur l'userform2 dans classeurB

J'espère être clair, sinon relis point par point ma dernière réponse
30/01/2011, 14h41
samimi94

Mercatog,

J'ai bien lu ce que tu as écrit, promis :D mais en fait je vois pourquoi je ne saisissais pas le code qui est d'ailleurs très bien expliqué.

En fait j'ai mis tous les codes dans le classeur A, je n'ai rien dans le classeur B, classeur B étant un classeur vierge qui s'ouvre par le biais du classeur A.

UserForm2.Show se trouve dans le SUB de la macro du Classeur A.
Les codes du USF2 sont également dans le Classeur A.

Mais le fait que tu ai mis dans le code précédent

Code:

ThisWorkbook.Close True

me garanti de ne pas affecter les données de mon classeur A.

En tout cas c'est un plaisir de lire tes codes et explications, j'en apprends tous les jours.

Many thanks.

Voilà, on se comprend petit à petit
1. Disposition des classeurs:
ClasseurA: Contient Feuil1, Feuil2 et Feuil3 et Userform2
ClasseurB: Contient Feuil1 (au moins)
2. Codes:
2.1. Module Public de ClasseurA, on déclare cette variable

Code:

1
2
Option Explicit
Public Wbk As Workbook

2.2 Bouton qui permet d'ouvrir ClasseurB et afficher Userform2

Code:

1
2
3
4
Private Sub CommandButton1_Click()
Set Wbk = Workbooks.Open("C:\Users\user\Desktop\TonFichierB.xls")
UserForm2.Show
End Sub

2.3 Codes de Userform2 (qui appartient désormais à ClasseurA)
on remplace partout ThisWorkBook par la variable publique Wbk (déclarée dans un module public: point 2.1)

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
Option Explicit
 
Private Sub UserForm_Initialize()
Dim LastLig As Long, i As Long
Dim MonDico As Object
 
With Wbk.Worksheets("Feuil1") 'Correspond à Feuil1 de ClasseurB
   LastLig = .Cells(.Rows.Count, "B").End(xlUp).Row
   .Range("B1:B" & LastLig).Sort Key1:=.Range("B2"), Order1:=xlAscending, Header:=xlYes
   Set MonDico = CreateObject("scripting.dictionary")
   For i = 2 To LastLig
      If Trim(.Range("B" & i).Value) <> "" Then MonDico(UCase(.Range("B" & i).Value)) = 1
   Next i
   Me.ListBox1.List = MonDico.keys
   Set MonDico = Nothing
End With
End Sub
 
Private Sub Transfert_Click()
With Me.ListBox1
   If .ListIndex > -1 Then
      Me.ListBox2.AddItem .List(.ListIndex)
      .RemoveItem .ListIndex
      .ListIndex = -1
   End If
End With
End Sub
 
Private Sub Valider_Click()
Dim Sh As Worksheet
Dim LastLig As Long
Dim i As Integer
Dim Tblo() As String
 
Application.ScreenUpdating = False
If Me.ListBox2.ListCount > 0 Then
   ReDim Tblo(1 To Me.ListBox2.ListCount)
   For i = 0 To Me.ListBox2.ListCount - 1
      Tblo(i + 1) = Me.ListBox2.List(i)
   Next i
   Set Sh = Wbk.Worksheets.Add   'Ajoute une feuille tampon sur classeurB
   With Wbk.Worksheets("Feuil1") 'Correspond à Feuil1 de ClasseurB
      .AutoFilterMode = False
      LastLig = .Cells(.Rows.Count, "B").End(xlUp).Row
      .Range("B1:B" & LastLig).AutoFilter field:=1, Criteria1:=Tblo, Operator:=xlFilterValues
      .Range("A1:X" & LastLig).SpecialCells(xlCellTypeVisible).Copy Sh.Range("A1")
      .AutoFilterMode = False
      .UsedRange.ClearContents
      Sh.UsedRange.Cut .Range("A1")
   End With
   Application.DisplayAlerts = False
   Sh.Delete
   Application.DisplayAlerts = True
   Set Sh = Nothing
   Unload Me
   Wbk.Close True
   Set Wbk = Nothing
Else
   MsgBox "Aucune donnée à traiter"
End If
End Sub

30/01/2011, 15h19
samimi94

Mercatog,

Je saisi mieux.
Alors j'ai suivi pas à pas tes instructions, mais j'ai une erreur sur

UserForm2.Show

Le message est :

erreur d execution 1004
La méthode Sort de la classe Range a échoué.

Ai-je loupé quelque chose ?

Merci.

Tu as cette erreur parce que peut être tu n'as pas adapté le nom de la feuille à trier, regarde ici
Code:

1 2 3 With Wbk.Worksheets("Feuil1") 'Correspond à Feuil1 de ClasseurB LastLig = .Cells(.Rows.Count, "B").End(xlUp).Row .Range("B1:B" & LastLig).Sort Key1:=.Range("B2"), Order1:=xlAscending, Header:=xlYes
On trie la colonne B de Feuil1 de classeurB avec en B1 le titre de la colonne

30/01/2011, 16h39
samimi94

Mercatog,

Tu m'épates ;)

Ton code est super, je dirai même tes codes.

Un grand merci pour ton aide et ton partage de connaissances.

:ccool:
31/01/2011, 19h13
samimi94

Bonjour le forum,

J'ai un tout petit problème lorsque je clique sur le bouton valider avec EXCEL 2003 :

Code:

Operator:=xlFilterValues

xlFilterValues = erreur de compilation - variable non définie

Si quelqu'un a une idée.

PS : Sous 2007 je n'ai pas d'erreur.

Merci

N'est pas prévue sur Excel 2003 (désolé, je n'avais pas fais attention à ta version d'excel)
sinon, une alternative:

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
Private Sub Valider_Click()
Dim Sh As Worksheet
Dim LastLig As Long
Dim i As Integer
 
Application.ScreenUpdating = False
If Me.ListBox2.ListCount > 0 Then
   Set Sh = Wbk.Worksheets.Add   'Ajoute une feuille tampon sur classeurB
   With Wbk.Worksheets("Feuil1")   'Correspond à Feuil1 de ClasseurB
      .AutoFilterMode = False
      LastLig = .Cells(.Rows.Count, "B").End(xlUp).Row
      For i = 0 To Me.ListBox2.ListCount - 1
         .Range("B1:B" & LastLig).AutoFilter field:=1, Criteria1:=Me.ListBox2.List(i)
         .Range("A1:X" & LastLig).SpecialCells(xlCellTypeVisible).Copy Sh.Cells(Sh.Rows.Count, 1).End(xlUp)(2)
      Next i
      Sh.Rows(1).Delete
      .AutoFilterMode = False
      .UsedRange.ClearContents
      Sh.UsedRange.Cut .Range("A1")
   End With
   Application.DisplayAlerts = False
   Sh.Delete
   Application.DisplayAlerts = True
   Set Sh = Nothing
   Unload Me
   Wbk.Close True
   Set Wbk = Nothing
Else
   MsgBox "Aucune donnée à traiter"
End If
End Sub

31/01/2011, 20h07
samimi94

Bonsoir Mercatog,

Pas de souci, j'utilise aussi XLS 2007 à la maison mais pas au bureau.

J'ai recopié ton code, cette fois il me met la même erreur sur :

Code:

Set Sh = Wbk.Worksheets.Add

le Wbk est surligné.

Merci encore.
31/01/2011, 20h13
samimi94

Mercatog,

J'ai déclaré la variable :

Code:

Dim wbk As Workbook

et ca fontionne.

Merci beaucoup pour ton nouveau code.

bonne soirée.
31/01/2011, 20h13
mercatog
On oublie vite notre chemin?
Tu continues sur ceci
Citation:
Voilà, on se comprend petit à petit
1. Disposition des classeurs:
ClasseurA: Contient Feuil1, Feuil2 et Feuil3 et Userform2
ClasseurB: Contient Feuil1 (au moins)
2. Codes:
2.1. Module Public de ClasseurA, on déclare cette variable

Code:

1 2 Option Explicit Public Wbk As Workbook

2.2 Bouton qui permet d'ouvrir ClasseurB et afficher Userform2

Code:

1 2 3 4 Private Sub CommandButton1_Click() Set Wbk = Workbooks.Open("C:\Users\user\Desktop\TonFichierB.xls") UserForm2.Show End Sub
31/01/2011, 20h14
samimi94

Non ca bug quand il y a des données :cry:

Voir 40 message(s) de cette discussion en une page