[Résolu] Copier des boutons avec le lien vers la macro

[mdidish]

Bonjour
J'ai un problème concernant la copie de boutons d'un classeur vers un autre.
Dans une macro, j'ai à un moment besoin de copier l'ensemble des boutons présents dans une feuille vers une feuille d'un autre classeur.

J'ai un classeur WB1 qui contient des boutons :
- bouton 1 lié à la macro "test1"
- bouton 2 lié à la macro "test2"

J'ai un autre classeur (WB2) qui contient également des macros dénommées "test1", "test2", ...

Je copie les boutons de WB1 vers WB2 avec ce code :

Workbooks("WB2").Worksheets("Feuil1").DrawingObjects.Delete
Workbooks("WB1").Sheets("Commandes").DrawingObjects.Copy
Workbooks("WB2").Worksheets("Feuil1").Activate
ActiveSheet.Range("A8").Select
ActiveSheet.Paste

Ca marche, mais les boutons collés dans WB2 dirigent vers les macros de WB1 : "'WB1.xlsm'!Test1".
Comment faire pour qu'ils dirigent vers "Test1" (la macro contenue dans WB2, et non dans WB1) ?

Merci

 

[mapomme]

Re : Copier des boutons avec le lien vers la macro

Bonjour mdidish,

Une piste dans les fichiers joints. Le code:

Sub Copie_Bouttons()
Dim shp As Shape, tablo
  Workbooks("mdidish-WB2.xlsm").Sheets("Feuil1").DrawingObjects.Delete
  Workbooks("mdidish-WB1.xlsm").Sheets("Feuil1").DrawingObjects.Copy
  Workbooks("mdidish-WB2.xlsm").Worksheets("Feuil1").Activate
  ActiveSheet.Range("A1").Select
  ActiveSheet.Paste
  For Each shp In Workbooks("mdidish-WB2.xlsm").Worksheets("Feuil1").Shapes
    If shp.OnAction <> "" Then
      tablo = Split(shp.OnAction, "!")
      shp.OnAction = "mdidish-WB2.xlsm" & "!" & tablo(UBound(tablo))
    End If
  Next shp
  [A1].Select
End Sub

 

[mdidish]

Re : Copier des boutons avec le lien vers la macro

Merci beaucoup pour la réponse ; je sentais que la solution viendrait d'un split mais je ne savais pas du tout comment l'exécuter.
C'est chose faite.