Liaisons à vérifier par VBA

chris · 27 Octobre 2014

Bonjour

Je dois tester à l'ouverture si tous les liens sont OK ou les modifier.

Il est facile de vérifier si le classeur lié existe à l'emplacement prévu mais y a t'il un moyen de connaître les onglets liés car il peut arriver que le classeur soit bien là mais un onglet lié introuvable...

Merci

Je ne mets pas d'exemple car c'est une question générale.

job75 · 30 Octobre 2014

Re : Liaisons à vérifier par VBA

Bonjour chris, le forum,

On peut en effet faire une boucle sur les fichiers, la liste obtenue sera facilement exploitable si elle n'est pas trop longue.

Adapte le dossier "Mes fichiers" et son chemin d'accès :

Code:

Sub Liens()
Dim chemin$, lig&, fichier$, d As Object
Dim w As Worksheet, P As Range, tablo, t
chemin = "C:\Mes fichiers\" 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With ThisWorkbook.Sheets(1) 'le fichier de la macro
  .[A:C].Clear
  .[C:C].NumberFormat = "@" 'format Texte
  .[A1:C1].Font.Bold = True
  .[A1] = "Classeur"
  .[B1] = "Feuille"
  .[C1] = "Formule (R1C1) de liaison donnant une valeur d'erreur"
  lig = 2
  fichier = Dir(chemin & "*.xls*") '1er fichier du dossier
  While fichier <> ""
    Set d = CreateObject("Scripting.Dictionary")
    Workbooks.Open chemin & fichier '1ère ouverture
    ActiveWorkbook.SaveLinkValues = False
    ActiveWorkbook.Save
    Workbooks.Open chemin & fichier '2ème ouverture
    For Each w In ActiveWorkbook.Worksheets
      Set P = w.UsedRange
      tablo = Union(P, P(2)).FormulaR1C1 'au moins 2 éléments
      For Each t In tablo
        If Left(t, 1) = "=" Then
          If InStr(t, "[") Then
            If Not d.exists(t) Then 'évite les doublons
              d(t) = ""
              If IsError(ExecuteExcel4Macro(Mid(t, 2))) Then
                .Cells(lig, 1) = fichier
                .Cells(lig, 2) = w.Name
                .Cells(lig, 3) = t
                lig = lig + 1
              End If
            End If
          End If
        End If
      Next
    Next
    ActiveWorkbook.Close False 'fermeture du fichier
    fichier = Dir 'fichier suivant du dossier
  Wend
  .Columns.AutoFit
End With
End Sub

A+

job75 · 30 Octobre 2014

Re : Liaisons à vérifier par VBA

Re,

C'est vraiment pour pinailler.

Si dans un des fichiers on entre le texte d'une formule de liaison au format "A1" dans une cellule au format "Texte" la macro beugue sur ExecuteExcel4Macro.

Pour l'éviter il suffit d'ajouter On Error Resume Next en début de macro.

A+

job75 · 2 Novembre 2014

Re : Liaisons à vérifier par VBA

Bonjour chris, le forum,

Pour exploiter la liste obtenue, la compléter manuellement en entrant :

- en colonne D => [AncienNomFichier]AncienNomFeuille

- en colonne E => [NouveauNomFichier]NouveauNomFeuille

Puis lancer cette macro :

Code:

Sub Nettoyage()
Dim chemin$, c As Range
chemin = "C:\Mes fichiers\" 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
For Each c In Sheets(1).Range("A2", Sheets(1).[A65536].End(xlUp)(2))
  If c <> c(0) Then
    Workbooks(c(0).Text).Close True
    Workbooks.Open chemin & c
  End If
  Workbooks(c.Text).Sheets(c(, 2).Text).Cells.Replace c(, 4), c(, 5), xlPart
Next
End Sub

A+

chris · 2 Novembre 2014

Re : Liaisons à vérifier par VBA

Bonjour job75

Effectivement le tableau gagne du temps 🙂 même si là je viens de le tester sur 1 seul fichier

Peux-tu expliciter le fonctionnement de
"tablo = Union(P, P(2)).FormulaR1C1 'au moins 2 éléments"
car je comprends le pourquoi mais pas le comment 😕.

J'ai du faire une modif car j'avais plein de formules, où le [ est présent, qui coinçaient : exemple

=IF(AND(R[-5]C[2]+R[-4]C[2]+R[-3]C[2]=1,R[-5]C[3]+R[-4]C[3]+R[-3]C[3]=1,R[-5]C[4]+R[-4]C[4]+R[-3]C[4]=1),"","Attention ! ")

et si je mets le "on error resume next" elles sont traitées et listées.

J'ai créé un second tableau avec les formules en formulation classique : cela permet d'éviter cela en testant la chaîne sur le second.
On pourrait sans doute tester aussi la présence de ".xls*" dans la formule du 1er tableau mais comme je préfère aussi lister sous ce format, ce second tableau résout les 2.

Sinon pour le traitement complet du cas qui a initialement soulevé ma question a priori je pense que, le chemin ancien et le chemin nouveau des classeurs liés étant fournis au départ, on pourrait traiter ainsi, après vérification de l'existence des dossiers,
Boucle sur les classeurs :

ouverture du classeur
liste des feuilles liées dans un classeur vierge (ton code)
boucle sur les classeurs liés
- ouverture du classeur situé dans le nouveau chemin
- vérification de la présence des feuilles listées dans les liens (ta liste), en boucle
  - si feuille absente :
    - ajout d'une mention KO dans la liste des feuilles liées
- fermeture du classeur lié
si au moins une feuille absente dans un des classeurs liés :
- fermeture du classeur et déplacement de celui-ci dans un dossier "traités_KO"
- enregistrement de la liste de liens dans ce même dossier avec un nom similaire au classeur+un suffixe
si pas de feuille absente :
- mise à jour des liens
- enregistrement du classeur
- fermeture du classeur et déplacement de celui-ci dans un dossier "traités_OK"

Qu'en penses-tu ?

job75 · 2 Novembre 2014

Re : Liaisons à vérifier par VBA

Re chris,

Ah bien sûr, au temps pour moi, j'oubliais les crochets des références relatives.

Alors travaillons sur le style A1 et utilisons la fonction ConvertFormula :

Code:

Sub Liens()
Dim chemin$, lig&, fichier$, w As Worksheet, P As Range, tablo, t, x$
chemin = "C:\Mes fichiers\" 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With ThisWorkbook.Sheets(1) 'le fichier de la macro
  .[A:C].Clear
  .[C:C].NumberFormat = "@" 'format Texte
  .[A1:C1].Font.Bold = True
  .[A1] = "Classeur"
  .[B1] = "Feuille"
  .[C1] = "Formule de liaison donnant une valeur d'erreur"
  lig = 2
  fichier = Dir(chemin & "*.xls*") '1er fichier du dossier
  While fichier <> ""
    Workbooks.Open chemin & fichier '1ère ouverture
    ActiveWorkbook.SaveLinkValues = False
    ActiveWorkbook.Save
    Workbooks.Open chemin & fichier '2ème ouverture
    For Each w In ActiveWorkbook.Worksheets
      Set P = w.UsedRange
      tablo = Union(P, P(2)).Formula 'au moins 2 éléments
      For Each t In tablo
        If Left(t, 1) = "=" Then
          If InStr(t, "[") Then
            x = Application.ConvertFormula(t, xlA1, xlR1C1)
            If IsError(ExecuteExcel4Macro(Mid(x, 2))) Then
              .Cells(lig, 1) = fichier
              .Cells(lig, 2) = w.Name
              .Cells(lig, 3) = t
              lig = lig + 1
            End If
          End If
        End If
      Next
    Next
    ActiveWorkbook.Close False 'fermeture du fichier
    fichier = Dir 'fichier suivant du dossier
  Wend
  .Columns.AutoFit
End With
End Sub

Edit : j'ai retiré le "Scripting.Dictionary".

Concernant ta question sur tablo = Union(P, P(2)).Formula :

- un tableau VBA doit avoir au moins 2 éléments

- donc si P est constituée d'une seule cellule, son union avec P(2) donnera 2 cellules jointives...

Pour ce qui est de ta procédure, pourquoi pas.

Ce qui est important c'est de modifier le chemin, le classeur et la feuille en même temps.

A+

chris · 2 Novembre 2014

Re : Liaisons à vérifier par VBA

Re

Merci beaucoup : ConvertFormula est effectivement la solution.

job75 · 3 Novembre 2014

Re : Liaisons à vérifier par VBA

Bonjour chris, le forum,

Le "Scripting.Dictionary" devait se faire par feuille et non par fichier.

Avec le style A1 il ne présente plus guère d'intérêt, je l'ai retiré dans la macro précédente.

A+

chris · 3 Novembre 2014

Re : Liaisons à vérifier par VBA

Bonjour Job75

Si j'ai bien compris il évitait de mettre plusieurs fois la même formule dans le rapport ?

job75 · 3 Novembre 2014

Re : Liaisons à vérifier par VBA

Re,

Oui c'est ça, le Dictionary permet d'éliminer les doublons.

A+

Liaisons à vérifier par VBA

chris

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

chris

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

chris

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

chris

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Discussions similaires

Liaisons à vérifier par VBA

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency