Bonjour,
ci joint du code pour supprimer des liaisons
Bon courage
Sub SupprimerLiaisonsExternes()
Application.ScreenUpdating = False
Dim MaFeuille As Worksheet
Dim MaCellule As Range
For Each MaFeuille In ActiveWorkbook.Sheets
For Each MaCellule In MaFeuille.Range('A1:BJ500') 'Plage en dur
If MaCellule.HasFormula = True And InStr(1, MaCellule.Formula, '[',
0) > 0 Then
'si la cellule est de type formule et elle contient un [ signifiant un lien externe
MaCellule.Formula = MaCellule.Value 'remplace la formule par la valeur
End If
Next MaCellule
Next MaFeuille
End Sub
Sub ChercheLiaison() 'IDENTIFIER LES LIASONS DANS UN CLASSEUR
Dim NomFichier As String, MonClasseur As Workbook, Liaisons As Variant
Dim compteur As Long, comptCar As Long, Cible As Range
Dim FirstAddress As String, PlageLiee As Range, comptFeuille As Long, Reponse As Integer
Dim MaFeuille As Worksheet
Application.ScreenUpdating = False
NomFichier = Application.GetOpenFilename
Workbooks.Open NomFichier, False
Set MonClasseur = ActiveWorkbook
Liaisons = MonClasseur.LinkSources
If IsEmpty(Liaisons) Then MsgBox ('Aucune liaison')
Exit Sub
'parcours les feuilles
For Each MaFeuille In MonClasseur.Worksheets
MaFeuille.Activate
MaFeuille.Cells.Select
For compteur = 1 To UBound(Liaisons)
For comptCar = Len(Liaisons(compteur)) To 1 Step -1
If Mid(Liaisons(compteur), comptCar, 1) = '\\' Then
Liaisons(compteur) = Mid(Liaisons(compteur), comptCar + 1)
Exit For
End If
Next comptCar
Set Cible = Selection.Find(What:=Liaisons(compteur), After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If Not Cible Is Nothing Then
FirstAddress = Cible.Address
Do
If PlageLiee Is Nothing Then Set PlageLiee = Cible Else Set PlageLiee = Union(PlageLiee, Cible)
Set Cible = Selection.FindNext(After:=Cible)
Loop While Not Cible Is Nothing And Cible.Address <> FirstAddress
End If
Next compteur
If Not PlageLiee Is Nothing Then
Reponse = MsgBox('La feuille ' & MaFeuille.Name & ' contient ' & PlageLiee.Cells.Count & _
' cellules avec des liaisons' & vbCrLf & _
'voulez-vous les supprimer ?', vbYesNo + vbQuestion, 'Liaisons trouvées')
If Reponse = 6 Then
'rupture des liaisons
For Each Cible In PlageLiee.Cells
Cible.Formula = Cible.Value
Next
End If
Set PlageLiee = Nothing
End If
Next
End Sub
