Bonjour à tous,
Ayant surfé un peu partout pour essayer de trouver réponse à mon problème, je viens à vous car à bout !
Je me suis inspiré d'un userform et des codes VBA associés déjà existants que j'ai trouvé sur le net pour établir le mien.
Le seul problème c'est qu'un message d'erreur apparaît lorsque je cherche à l'exécuter :
"Le membre existe déjà dans un module objet dont le présent module est dérivé"
Il s'agirait d'une Private Sub, du nom de cmdefface mais impossible de retrouver l'occurrence ailleurs...
Voici le code associé au userform
This is the procedure to clear the userform and the worksheet.
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
52
53 Option Explicit Sub ShowMe() 'show the userform frmFilter.Show End Sub Sub Filterme() ' ' Filterme Macro ' ' Sheets("Data").Range("A1:Q9358").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("Filtres!Criteria"), CopyToRange:=Range( _ "Filtres!Extract"), Unique:=False End Sub Sub Clearme() ' ' Clearme Macro ' ' ActiveWindow.SmallScroll Down:=-3 Range("B8").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Borders(xlEdgeLeft).LineStyle = xlNone Selection.Borders(xlEdgeTop).LineStyle = xlNone Selection.Borders(xlEdgeBottom).LineStyle = xlNone Selection.Borders(xlEdgeRight).LineStyle = xlNone Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone Selection.ClearContents ActiveWindow.ScrollColumn = 1 Range("B5:F5").Select Selection.ClearContents End Sub Sub Clear() 'clear the values form the userform With Me .CBoxsociete.Value = "" .Txtfournisseur.Value = "" .TextBox2.Value = "" .TextBox1.Value = "" .TextBox3.Value = "" End With End Sub
D'avance excusez moi pour la longueur du code, mais j'imagine que je dois être exhaustif pour pouvoir me faire comprendre...
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
52
53
54
55
56
57
58
59
60 Private Sub cmdefface 'Clear the userform Clear 'clear the rowsourse Clearme 'clear the listbox Me.lstData.RowSource = "" End Sub ' The code below closes the userform Private Sub cmdClose_Click() 'close the userform Unload Me End Sub Private Sub cmdFilter_Click() Dim ws As Worksheet 'set worksheet variable Set ws = Sheet12 'Make sure it is a proper DA If Not IsNumeric(Me.TextBox2) And Me.TextBox2 <> "" Then MsgBox "Le numéro de BDC n'est pas valide" Me.TextBox2 = "" Exit Sub End If 'Make sure it is a proper BDC If Not IsNumeric(Me.TextBox1) And Me.TextBox1 <> "" Then MsgBox "Le numéro de DA n'est pas valide" Me.TextBox1 = "" Exit Sub End If 'Make sure it is a proper facture If Not IsNumeric(Me.TextBox3) And Me.TextBox3 <> "" Then MsgBox "Le numéro de facture n'est pas valide" Me.TextBox1 = "" Exit Sub End If 'send the values to the worksheet With ws .Range("B5").Value = Me.CBoxsociete.Value .Range("C5").Value = Me.Txtfournisseur.Value .Range("D5").Value = Me.TextBox1.Value .Range("E5").Value = Me.TextBox2.Value .Range("F5").Value = Me.TextBox3.Value End With 'run the advanced filter Filterme 'add the named range to the rowsource If ws.Range("B8").Value = "" Then Me.lstData.RowSource = "" MsgBox "Aucune donnée correspondante" Else Me.lstData.RowSource = "FilterData" End If End Sub
La partie qui empêche l'exécution de se faire est Private Sub cmdefface.
Un grand merci d'avance à celles et ceux qui pourront prendre un peu de leur temps pour m'aider là dessus !
arochab
Partager