Modification macro dans bouton VBA à grande échelle de façon neutre

Boujour à tous,

Je suis confronté depuis quelques jours à un problème que je n'arrive pas du tout à régler même avec l'IA.

Je dois modifier des macro dans des boutons VBA pour un grand nombre de fichiers (<300) pour ce faire j'ai écrit le code que vous pouvez trouver ci-joint. Le problème est que la macro à insérer dans mon bouton est un fichier ".xlam", qui est dans mon C:\....\appdata\roaming\microsoft\addin. Ce qui se passe est que lorsque je change le nom de ma macro mon bouton va chercher le lien dans mon "C", toutefois je souhaiterais que d'autre collègue puisse utiliser ces boutons.

Pour essayer de résumé, je voudrais trouver comment migrer le nom de bouton VBA de manière neutre, c'est à dire en désactivant mon AddIn. Ex : le bouton sera renomme "

nomprojetVBA.module.programme

" sans attache à un fichier particulier.

Merci d'avance pour votre aide !!

Public Sub NettoyerEtMigrerBoutons()

Const ADDIN_FULL  As String = "nomprojetVBA.module.programme"
Const ADDIN_SUPP  As String = "nomprojetVBA.module.programme"
Const ADDIN_RENOM As String = "nomprojetVBA.module.programme"

    Dim fd As FileDialog
    Dim f As Variant
    Dim wb As Workbook, Migration_bouton As Workbook
    Dim ws As Worksheet, wsPres As Worksheet
    Dim shp As Shape, btn As Button
    Dim logRow As Long
    Dim nbErr As Long
    Dim i As Long
    Dim c As Range
    Dim modificationFaite As Boolean

    On Error GoTo ErreurFichier

    Set Migration_bouton = ThisWorkbook

    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "Fichiers Excel", "*.xlsm;*.xlsb;*.xlsx"
        .Title = "Sélectionnez les fichiers des collègues à réparer"
        If .Show <> -1 Then Exit Sub
    End With

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False

    For Each f In fd.SelectedItems

        Set wb = Nothing
        modificationFaite = False

        '--- Ouverture fichier
        Set wb = Workbooks.Open(f, UpdateLinks:=0, ReadOnly:=False)

        Application.EnableEvents = True
        DoEvents
        Application.EnableEvents = False

        For Each ws In wb.Worksheets

            For i = ws.Shapes.Count To 1 Step -1
                Set shp = ws.Shapes(i)

                If shp.OnAction <> "" Then

                    '--- 1. Détection et nettoyage du bouton SUPPRIMER FEUILLE
                    If InStr(1, shp.OnAction, "supprimer_feuille", vbTextCompare) > 0 Then
                        shp.OnAction = ADDIN_SUPP
                        modificationFaite = True
                    End If

                    '--- 2. Détection et nettoyage du bouton BOUTON4 / TOUT
                    If InStr(1, shp.OnAction, "bouton4_cliquer", vbTextCompare) > 0 _
                    Or InStr(1, shp.OnAction, "Tout", vbTextCompare) > 0 Then
                        shp.OnAction = ADDIN_FULL
                        modificationFaite = True
                    End If

                    '--- 3. Nettoyage de l'ancien bouton obsolète si présent
                    If InStr(1, shp.OnAction, "Enregistrer_Excel", vbTextCompare) > 0 Then
                        shp.Delete
                        modificationFaite = True
                    End If

                End If
            Next i
        Next ws

        On Error Resume Next
        wb.RemovePersonalInformation = False

        ' Si des modifications ont été apportées, on force la sauvegarde, sinon on ferme juste
        If modificationFaite Then
            wb.Close SaveChanges:=True
        Else
            wb.Close SaveChanges:=False
        End If
        On Error GoTo 0

        GoTo FichierSuivant

ErreurFichier:
        nbErr = nbErr + 1
        If Not wb Is Nothing Then wb.Close SaveChanges:=False
        On Error GoTo 0

FichierSuivant:
    Next f

    '======================
    ' RESTAURATION EXCEL
    '======================
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True

    MsgBox "Nettoyage  terminés ! Erreurs : " & nbErr, vbInformation

End Sub
Rechercher des sujets similaires à "modification macro bouton vba grande echelle facon neutre"