Lancement macro par menu contextuel

Bonjour,

J'ai actuellement un lancement de macro par menu contextuel, le menu est créé à l'ouverture d'un fichier de chiffrage et supprimé a la fermeture de celui-ci.

( La macro permet de rajouter des lignes "proprement", formules et autres ainsi que sauvegarde des lignes rajoutés dans un autre fichier )

Le souci est que plusieurs fichiers de ce type peuvent être ouvert mais que le menu contextuel, donc la macro, est associé au premier fichier ouvert, donc cela ne fonctionne pas sur les autres fichier. ( l'autre souci est que je supprime à la fermeture d'un fichier le menu, pas vraiment un souci ca ne me dérange pas que le menu contextuel reste tout le temps )

En clair comment associer le lancement de la macro ce trouvant dans le fichier en cour d'utilisation ?

Le code pour créer le menu:

Sub MenuContex()

    On Error Resume Next

    Application.CommandBars("Cell").Reset

    Dim cBut3 As CommandBarButton
    Dim MaBarre1 As CommandBar

    'on détermine la command bar que l'on veux modifier
    Set MaBarre1 = Application.CommandBars("cell")
    'on y ajoute un bouton "toto"
    Set cBut3 = MaBarre1.Controls.Add(Type:=msoControlButton)
    With cBut3
        .FaceId = 2161    '<-- bouton avec icône + texte
        .Caption = "Ajouter un article"    '<-- label du bouton
        .OnAction = "AfficheAjout"    ' appel a sa macro associée
    End With

End Sub

Ma macro permet d'afficher une nouvelle feuille, d'en éditer une autre pour venir remplir les différentes cellule de la première tout en rajoutant une ligne. J'ai donc dans le fichier des variables public.

Je vous met le gros de la macro, je ne pense pas que j'ai besoin d'envoyer le fichier, si c'est neccesair, je le ferai ( mais demain...trop de nettoyage a faire ^^ )

Public NoCellArticle As String

Public Zone As String

Public sh As Worksheet

Public NumDossier As String

Public Function FichierExiste(MonFichier As String)

If Len(Dir(MonFichier)) > 0 Then

FichierExiste = True

Else

FichierExiste = False

End If

End Function

Sub AfficheAjout()

NoCellArticle = ActiveCell.Row

Zone = Cells(NoCellArticle, 2)

Set sh = ActiveSheet

NumDossier = Left(ThisWorkbook.Name, 11)

sh.Unprotect ("mdp")

ActiveCell.EntireRow.Insert

Worksheets("Ajout").Visible = True

Worksheets("Ajout").Activate

End Sub

Sub MasqueAjout()

Worksheets("Ajout").Visible = False

End Sub

Sub AjouterArticle()

Sheets("Accueil").Range("AD4") = "Edition"

If Zone = "OE" And Sheets("Ajout").Range("AjPabs") = "" Then

GoTo Fin

End If

If Zone = "S" And Sheets("Ajout").Range("AjDebit") = "" Then

GoTo Fin

End If

Suite:

sh.Range("B" & NoCellArticle & ":Z" & NoCellArticle & "").Font.ColorIndex = 3

sh.Cells(NoCellArticle, 2).Value = Zone 'code

sh.Cells(NoCellArticle, 3).Value = Range("AjDesiBase") 'désignation basique

sh.Cells(NoCellArticle, 4).Value = Range("AjQte") 'quantité

sh.Cells(NoCellArticle, 5).Value = Range("AjMP") 'MP

sh.Cells(NoCellArticle, 6).Value = Range("AjMO") 'MO

sh.Cells(NoCellArticle, 7).Formula = "=(E" & NoCellArticle & "+F" & NoCellArticle & "* TxHoraire)" 'PR

sh.Cells(NoCellArticle, 8).Value = Range("AjMarge") 'Marge

sh.Cells(NoCellArticle, 8).NumberFormat = "0%" 'Marge

sh.Cells(NoCellArticle, 9).Formula = "=(G" & NoCellArticle & ")/(1-H" & NoCellArticle & ")" 'PV mini

sh.Cells(NoCellArticle, 10).Value = Range("AjPVValide") 'PV validé

sh.Cells(NoCellArticle, 11).Formula = "=(J" & NoCellArticle & "-G" & NoCellArticle & ")/J" & NoCellArticle & "" 'Marge réelle

sh.Cells(NoCellArticle, 11).NumberFormat = "0%" 'Marge réelle

sh.Cells(NoCellArticle, 12).Formula = "=(J" & NoCellArticle & "*D" & NoCellArticle & ")" 'PV totale

sh.Cells(NoCellArticle, 13).Formula = "=(D" & NoCellArticle & "*E" & NoCellArticle & ")" 'Total MP

sh.Cells(NoCellArticle, 14).Formula = "=(D" & NoCellArticle & "*F" & NoCellArticle & ")" 'Total MO

sh.Cells(NoCellArticle, 14).Formula = "=(G" & NoCellArticle & "*D" & NoCellArticle & ")" 'Total PR

sh.Cells(NoCellArticle, 21).Value = Range("AjDesiDesc") 'désignation basique

sh.Cells(NoCellArticle, 22).Value = "=CONCATENATE(" & "D" & NoCellArticle & "" & ","" - ""," & "U" & NoCellArticle & ")" 'désignation descriptif

sh.Cells(NoCellArticle, 18).Value = Range("AjRefCegid") 'refcégid

'détail descriptif N°1

If Range("AjDetailDesc1") <> "" Then

sh.Rows(NoCellArticle + 1).Insert

sh.Cells(NoCellArticle + 1, 22).Value = Range("AjDetailDesc1")

sh.Cells(NoCellArticle + 1, 4).Formula = "=(D" & NoCellArticle & ")"

sh.Cells(NoCellArticle + 1, 2).Value = Zone

sh.Cells(NoCellArticle + 1, 3).Value = "Détail N°1"

End If

'détail descriptif N°2

If Range("AjDetailDesc2") <> "" Then

sh.Rows(NoCellArticle + 2).Insert

sh.Cells(NoCellArticle + 2, 22).Value = Range("AjDetailDesc2")

sh.Cells(NoCellArticle + 2, 4).Formula = "=(D" & NoCellArticle & ")"

sh.Cells(NoCellArticle + 2, 2).Value = Zone

sh.Cells(NoCellArticle + 2, 3).Value = "Détail N°2"

End If

'Si ref cégid, edition BE couleur en noir

If Range("AjRefCegid") <> "" Then

sh.Range("B" & NoCellArticle & ":Z" & NoCellArticle & "").Font.ColorIndex = 1

End If

'renseignement temps prod

DernLigTpsMo = Sheets("PROD").Range("B65536").End(xlUp).Row

Sheets("PROD").Cells(DernLigTpsMo + 1, 2) = Zone

Sheets("PROD").Cells(DernLigTpsMo + 1, 4) = Range("AjDesiBase")

Sheets("PROD").Cells(DernLigTpsMo + 1, 8) = Range("AjMO")

Call MasqueAjout

'remise à zéro de la feuille ajout

Sheets("Ajout").Range("AjDesiBase") = ""

Sheets("Ajout").Range("AjQte") = ""

Sheets("Ajout").Range("AjMP") = ""

Sheets("Ajout").Range("AjMO") = ""

Sheets("Ajout").Range("AjMarge") = 0.3

Sheets("Ajout").Range("AjPVValide") = ""

Sheets("Ajout").Range("AjDesiDesc") = ""

Sheets("Ajout").Range("AjPabs") = ""

Sheets("Ajout").Range("AjDebit") = ""

Sheets("Ajout").Range("AjRefCegid") = ""

sh.Activate

'Remplissage fichier d'articles ajoutés

sh.Range("B" & NoCellArticle & ":v" & NoCellArticle & "").Copy

Dim MonFichier As String

MonFichier = "\\SRVAD\Datas\Bureau d'étude\6-Matrices\Articles Ajoutés\Articles Ajoutés.xlsm"

If FichierExiste(MonFichier) = False Then

sh.Range("R" & NoCellArticle).Select

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.Color = 255

.TintAndShade = 0

.PatternTintAndShade = 0

End With

GoTo Passe

End If

Workbooks.Open Filename:="\\SRVAD\Datas\Bureau d'étude\6-Matrices\Articles Ajoutés\Articles Ajoutés.xlsm"

If Workbooks("Articles Ajoutés.xlsm").ReadOnly = True Then

ActiveWindow.Close

sh.Range("R" & NoCellArticle).Select

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.Color = 255

.TintAndShade = 0

.PatternTintAndShade = 0

End With

GoTo Passe

End If

DerLigArtAj = Sheets("Articles Ajoutés").Range("A65536").End(xlUp).Row

Sheets("Articles Ajoutés").Cells(DerLigArtAj + 1, 1).PasteSpecial xlPasteValues

Range("v" & DerLigArtAj + 1) = Application.UserName

Range("w" & DerLigArtAj + 1) = NumDossier

Range("x" & DerLigArtAj + 1) = "Evolis"

Range("y" & DerLigArtAj + 1) = Date

ActiveWorkbook.Save

ActiveWindow.Close

Passe:

sh.Protect ("mdp")

Fin:

Sheets("Accueil").Range("AD4") = ""

End Sub

Sub AnnulerAjouterArticle()

sh.Activate

Cells(NoCellArticle, 1).EntireRow.Delete

sh.Protect ("mdp")

Sheets("Accueil").Range("AD4") = ""

Call MasqueAjout

End Sub

En espérant avoir été clair...merci d'avance.

Bonjour,

Un bon moyen pour qu'une macro soit utilisable sur plusieurs classeurs et d'utiliser un fichier de macros complémentaires.

Une piste entre autres : https://forum.excel-pratique.com/excel/macro-complementaire-t37374.html

Gelinotte

Merci pour la réponse.

J'ai testé, j'arrive a lancer la macro complémentaire mais...je bloque déjà avec les variables.

J'ai plusieurs variables que j'utilise en "public" et la je ne sais pas comment faire.

Je regarderai cela du plus prés ce soir.

Cdt

Merci Gelinotte , je valide même si au finale j’abandonne,

• merci pour m'avoir donnée les bon termes de recherche
• j’abandonne car c'est une voie complexe dont je suis pas capable...

J'ai trouvé une voie plus simple, ouvrir une session Excel par fichier, cela règle mes problèmes.

Avec une macro complémentaire...il me faudrait des variables globales ? J'ai déjà du mal à déclarer une variable...

[hors sujet]

j'arrive a ouvrir une session Excel par fichier sur v2013 mais pas 2010, j'ai trouvé des solutions pour la 2010 mais j'arrive pas a l’appliquer... j'abandonne également, on passe inter services à 2013-2016 en janvier....noël en retard mais noël ^^

je reviendrai peut-être si je bloque.

Bref merci, je clot

Cdt