Bouton macro excel sous word

Bonjour à tous,

alors voilà mon problème : j'ai une macro excel qui permet de copier des données d'un tableur à un autre, jusque là tout va bien. Cette macro est associée à un bouton pour la lancer, jusque là tout va toujours bien. Par contre, je dois intégrer mon classeur excel avec la macro dans un document word et là, le bouton ne fonctionne plus. Je peux lancer la macro à partir de l'éditeur VBA mais impossible de lui associer un bouton...

Si quelqu'un à une solution !

Public Sub msp_tomo()

Dim A2 As Integer
Dim i As Integer
'------------------------------------------------------------------------------------------------
Dim nom As Variant
Dim WBlisting As Workbook
Dim WBMSP As Workbook
Dim msp As Workbook
Dim WScbre As Worksheet
Dim WSdelta4 As Worksheet
Dim WSlist As Worksheet
'------------------------------------------------------------------------------------------------

'Workbooks.Open Filename:="\\shares.sih.cav\Profiles$\Bureau\msp-tomo.xlsm"

ChDir "\\svprodariaimage.sih.cav\physique_aria\Mesures_Physique\CQ_Tomo\CQ_Patients"
Workbooks.Open Filename:="\\svprodariaimage.sih.cav\physique_aria\Mesures_Physique\CQ_Tomo\CQ_Patients\Listing_Patient.xlsx"

ChDir "\\svprodariaimage\physique_aria\Mesures_Physique\CQ_Tomo\CQ_Patients"
Workbooks.Open Filename:="\\svprodariaimage\physique_aria\Mesures_Physique\CQ_Tomo\CQ_Patients\MSP DQA.xlsx"


Set WBlisting = Workbooks("Listing_Patient.xlsx")
Set WSlist = Workbooks("Listing_Patient.xlsx").Worksheets("Liste")

Set WBMSP = Workbooks("MSP DQA.xlsx")
Set WScbre = Workbooks("MSP DQA.xlsx").Worksheets("DQA_CI")
Set WSdelta4 = Workbooks("MSP DQA.xlsx").Worksheets("DQA_D4")



a = 0
a = WSlist.Range("E" & Rows.Count).End(xlUp).Row       'permet de trouver la derniere cellule remplis de la colonne E
A3 = WScbre.Range("A" & Rows.Count).End(xlUp).Row      'permet de trouver la derniere cellule remplis de la colonne A


j = 1                                                  'trouve le patient correspondant dans le listing à partir de l'IP du tableur CQ fx IMRT
For i = 1 To a
    If WSlist.Cells(i, 5) = Cells(2, 12) Then
    b = i
    End If
Next i



For i = 20 To A3

'Workbooks("MSP DQA.xlsx").Worksheets("DQA_CI").Activate
'Workbooks("Listing_Patient.xlsx").Worksheets("Liste").Activate

    If WScbre.Cells(i, 1) = WSlist.Cells(b, 2) Then     'se place sur le numéro patient correspondant dans le fichier MSP
        
        If WScbre.Cells(i, 8) <> 0 Then                 'permet de vérifier que le patient n'a pas déjà entrer dans le fichier MSP
        A2 = i + 1
        'MsgBox (A2)
        WScbre.Activate
        WScbre.Cells(A2, 8).Select
        Selection.EntireRow.Insert   'si oui, ajoute une ligne pour rentrer les nouvelles valeurs sur la feuille DQA_CI
        WSlist.Activate
        WScbre.Cells(A2, 1) = WSlist.Cells(b, 2)
        WScbre.Cells(A2, 2) = WSlist.Cells(b, 3)
        WScbre.Cells(A2, 3) = WSlist.Cells(b, 4)
        WScbre.Cells(A2, 4) = WSlist.Cells(b, 5)
        'thisworkbooks.Activate
        WScbre.Cells(A2, 5) = Cells(9, 8)
        WScbre.Cells(A2, 6) = Cells(9, 5)
        WScbre.Cells(A2, 7) = WSlist.Cells(b, 9)
        WScbre.Cells(A2, 8) = Cells(13, 8)
        WScbre.Cells(A2, 9) = Cells(14, 8)
        Exit For
        'MsgBox (A2)
        End If
    
        If WScbre.Cells(i, 8) = "" Then                   'si non remplis les valeurs à la ligne correspondant au numéro patient
'        thisworkbooks.Activate
        WScbre.Cells(i, 2) = WSlist.Cells(b, 3)
        WScbre.Cells(i, 3) = WSlist.Cells(b, 4)
        WScbre.Cells(i, 4) = WSlist.Cells(b, 5)
        WScbre.Cells(i, 5) = Cells(9, 8)
        WScbre.Cells(i, 6) = Cells(9, 5)
        WScbre.Cells(i, 7) = WSlist.Cells(b, 9)
        WScbre.Cells(i, 8) = Cells(13, 8)
        WScbre.Cells(i, 9) = Cells(14, 8)
        End If
        
   End If
    
        
        
Next i

j = 690

'MsgBox ("ok")
WSdelta4.Activate
        While (WSdelta4.Cells(j, 1).Value <> "")
        j = j + 1
        Wend
        
        'MsgBox ("ok")
        
        WSdelta4.Cells(j, 1) = WSlist.Cells(b, 5)
        WSdelta4.Cells(j, 2) = WSlist.Cells(b, 3)
        WSdelta4.Cells(j, 3) = WSlist.Cells(b, 4)
        'thisworkbooks.Activate
        WSdelta4.Cells(j, 4) = Cells(9, 8)
        WSdelta4.Cells(j, 5) = Cells(10, 12)
        WSdelta4.Cells(j, 6) = WSlist.Cells(b, 9)
        WSdelta4.Cells(j, 7) = Cells(12, 12)
        WSdelta4.Cells(j, 8) = Cells(14, 12)
        'Else
        'MsgBox ("remplir le fichier msp manuellement")
        

MsgBox ("ok")

WBlisting.Activate

WBlisting.Save
WBlisting.Close
WBMSP.Save
WBMSP.Close


Set WBlisting = Nothing
Set WBMSP = Nothing

End Sub