1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84
| Dim Nom_bud As String
Dim Nom_support As String
Nom_bud = ActiveWorkbook.Name 'récupère le nom du fichier bud
'décompose le nom du fichier bud en plusieurs morceaux
Dim str() As String
Dim i As Integer
str = Split(Nom_bud, "_")
For i = 0 To UBound(str)
'MsgBox Replace(str(i), ".xlsm", "")
Next i
'création du nom du fichier support à partir de la décomposition précédente
Nom_support = str(0) & "_support.xlsm"
'décomposition successive de la formule à remplacer
Dim formule As String
Dim strf() As String
Dim j As Integer
formule = Sheets("F&B").Range("C2").FormulaR1C1Local 'récupère la formule d'une cellule à remplacer
strf = Split(formule, "]")
For j = 0 To UBound(strf)
'MsgBox Replace(strf(j), "", "")
Next j
Dim formule_corrige As String 'rajoute la parenthèse de fin
formule_corrige = strf(0) & "]"
Dim strfc() As String ' enlever le ' avant le :C/
Dim k As Integer
strfc = Split(formule_corrige, "'")
For k = 0 To UBound(strfc)
'MsgBox Replace(strfc(k), ".xlsm]", "")
Next k
Dim formule_a_remplacer As String 'détermine la chaine de caractère à remplacer
formule_a_remplacer = strfc(1)
'détermine la chaine de caractère qui remplace
Dim remplace As String
remplace = "[" & Nom_support & "]"
' vérifie avec l'utilisateur les remplacements
If MsgBox("Le texte à remplacer est : " & Chr(10) & formule_a_remplacer & Chr(10) _
& "Le texte qui remplace est :" & Chr(10) & remplace & Chr(10) & Chr(10) _
& "Veuillez confirmer sur OK ou ANNULER.", vbOKCancel, "REMPLACE") = vbOK Then
'recherche les valeurs dans le classeur et remplace
Dim feuil As Worksheet
For Each feuil In ThisWorkbook.Worksheets
feuil.Activate
If feuil.Name = "SYNTHESIS P&L GROUP" Then
'Call liaison_synthese_groupe
Else
feuil.Cells.Replace What:=formule_a_remplacer, Replacement:=remplace
End If
Next feuil
MsgBox ("La liaison des formules a été réalisée avec succès.")
End If
Else
MsgBox ("Vous avez annuler le changement des formules.")
End If
End Sub
Sub Mettre_a_jour_liaison()
Call DeproFeuilles
Call Liaison
Call ProtegeFeuilles
Call Masque_commandes_bud
End Sub |
Partager