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 85 86 87 88
|
Sub ChercheLiaison()
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, MonGraphe As Chart, MonGraphe1 As ChartObject, MaSerie As Series
NomFichier = Application.GetOpenFilename
Workbooks.Open NomFichier, False
Set MonClasseur = ActiveWorkbook
Liaisons = MonClasseur.LinkSources
If IsEmpty(Liaisons) Then 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
For Each Cible In PlageLiee.Cells
Cible.Formula = Cible.Value
Next
End If
Set PlageLiee = Nothing
End If
For Each MonGraphe1 In MaFeuille.ChartObjects
'Test debug
'Reponse = MsgBox("le graphe de la feuille " & MonGraphe1.Name & _
'" contient une série " & MaSerie.Name & " avec des liaisons" & vbCrLf & _
'"Voulez-vous les supprimer ?", vbYesNo + vbQuestion, "Liaisons trouvées")
Debug.Print ("le graphe de la feuille " & MonGraphe1.Name)
Set MaSerie = MonGraphe1.SeriesCollection.Count ' Ajout pour debug tests KO Erreur 438
Debug.Print (" contient une série " & MaSerie.Name)
'Fin Test debug
'For Each MaSerie In MonGraphe1.SeriesCollection '<- bug ici Erreur 438 Objet ne prend pas en charge cette méthode
For Each MaSerie In MonGraphe1.SeriesCollection
For compteur = 1 To UBound(Liaisons)
If InStr(1, MaSerie.Formula, Liaisons(compteur), vbTextCompare) > 0 Then
Reponse = MsgBox("le graphe de la feuille " & MonGraphe1.Name & _
" contient une série " & MaSerie.Name & " avec des liaisons" & vbCrLf & _
"Voulez-vous les supprimer ?", vbYesNo + vbQuestion, "Liaisons trouvées")
If Reponse = 6 Then
MaSerie.Delete
Exit For
End If
End If
Next compteur
Next
Next
Next
For Each MonGraphe In MonClasseur.Charts
For Each MaSerie In MonGraphe.SeriesCollection
For compteur = 1 To UBound(Liaisons)
If InStr(1, MaSerie.Formula, Liaisons(compteur), vbTextCompare) > 0 Then
Reponse = MsgBox("le graphe de la feuille " & MonGraphe.Name & _
" contient une série " & MaSerie.Name & " avec des liaisons" & vbCrLf & _
"voulez-vous les supprimer ?", vbYesNo + vbQuestion, "Liaisons trouvées")
If Reponse = 6 Then
MaSerie.Delete
Exit For
End If
End If
Next compteur
Next
Next
End Sub |