Discussion :

[juju05]

Bonjour,

Je viens de rajouter un item sur le menu contextuel via le code :

Code :

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

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 :

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
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.

[issoram]

Bonjour,

Où (dans quel type de module) as-tu mis la fonction clic_droit?

[juju05]

J'ai fait insertion procédure type public.

[issoram]

Ce n'était pas ma question mais pas grave...
A mon avis ta procédure clic_droit est dans le "module" ThisWorkbook. Crée un module standard (Insertion module) et coupe/colle ta ta procédure dedans.

[juju05]

Parfait merci bien !