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