1 pièce(s) jointe(s)
Message d'erreur lors de l'exécution d'une macro. depuis un menu contextuel
Bonjour,
Je viens de rajouter un item sur le menu contextuel via le code :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
|
Private Sub Workbook_Open()
Sheets("PRIX").Activate
Application.CommandBars("Cell").Reset
With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = "Ajouter au devis "
.BeginGroup = True
.OnAction = "clic_droit"
End With
End Sub |
J'ai codé la macro. suivante :
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
| Sub clic_droit()
Dim tabCellules(), compteur As Integer
Dim cellule As Range
Dim b As Integer
Dim i As Integer, j As Integer, k As Integer
Dim rfound As Range
' Ouverture du fichier de remise de prix type
On Error Resume Next
Workbooks.Open Filename:="\\Serv\ode\gestion de tole\DEVIS CLIENT\remise de prix type.xls"
' stockage des lignes sélectionnées par clic-droit
compteur = 0
For Each cellule In Selection
ReDim Preserve tabCellules(compteur)
tabCellules(compteur) = cellule.Row
compteur = compteur + 1
Next cellule
ReDim Preserve tabCellules(compteur - 1)
Workbooks("remise de prix type.xls").Worksheets("Feuil1").Activate
' Recherche de "Référence" dans la colonne 'D'
Set rfound = Worksheets("Feuil1").Range("E1:E" & .Cells(.Rows.Count, "E").End(xlUp).Row).Find("Référence", LookIn:=xlValues)
' Si trouvé
If Not rfound Is Nothing Then
i = rfound.Row
End If
' Recherche du caractère xxxx dans la colonne 'D'
j = 0
Set rfound = Worksheets("Feuil1").Range("E28:E" & .Cells(.Rows.Count, "E").End(xlUp).Row).Find("xxxx", LookIn:=xlValues)
' Si trouvé
If Not rfound Is Nothing Then
j = rfound.Row
End If
' Détermination du nombre de lignes à supprimer
If j > i + 1 Then
k = j - i - 1
j = 1
Do Until j > k
Worksheets("Feuil1").Rows(j + i).Delete Shift:=xlUp
j = j + 1
Loop
End If
Workbooks("remise de prix type.xls").Worksheets("Feuil1").Activate
' Renseignement des différentes informations sur la feuille de remise de prix
For j = 0 To UBound(tabCellules)
Worksheets("Feuil1").Rows(i).Insert
With Worksheets("Feuil1")
.Range("D" & i).Value = Workbooks("CLASSEUR CALCUL DE PRIX 2015.xls").Worksheets("Prix").Cells(tabCellules(i), 2)
.Range("E" & i).Value = Workbooks("CLASSEUR CALCUL DE PRIX 2015.xls").Worksheets("Prix").Cells(tabCellules(i), 3)
.Range("H" & i).Value = Workbooks("CLASSEUR CALCUL DE PRIX 2015.xls").Worksheets("Prix").Cells(tabCellules(i), 8)
.Range("J" & i).Value = Workbooks("CLASSEUR CALCUL DE PRIX 2015.xls").Worksheets("Prix").Cells(tabCellules(i), 7)
.Range("Q" & i).Value = Workbooks("CLASSEUR CALCUL DE PRIX 2015.xls").Worksheets("Prix").Cells(tabCellules(i), 31)
.Range("R" & i).FormulaR1C1 = "=RC[-1]*RC[-2]"
End With
i = i + 1
Next j
End Sub |
Lorsque j'ouvre mon classeur, j'ai bien le menu contextuel que j'ai ajouté, par contre lorsque je le lance, j'ai le message d'erreur figurant en pièce-jointe.
