Accélérer code + liens hypertexte

[francedemo]

bonjour à tous,

je viens vers vous pour une aide sur la rapidité d'exécution d'une macro:
j'ai dans un répertoire 1 fichier "sommaire" + x fichiers "matériels" (jusqu'à 15000 "x")
le fichier "sommaire" fait un récapitulatif (classique) "n°matériel"..."Client"..."Adresse"..., et sur chaque "n°Mat", en fait je fais un lien hypertexte qui pointe vers le fichier correspondant.
jusque là, pas de soucis
là où ça se complique, c'est que le nom des fichier matériels peut changer (ajout "_SAV" quand une opération SAV est réalisé sur le matériel), du coup les liens hypertexte ne fonctionnent plus...
pour éviter les problèmes, je demande à l'ouverture du fichier "sommaire" de vérifier la validité des liens et je m'arrête sur le premier qui ne fonctionne pas pour demander une mise à jour du fichier.

pour ça j'utilise:

Private Sub Workbook_Open()

Dim Cible As String
Dim Fich As String
Dim i As Integer
Dim Num As Variant

With Application
   .ScreenUpdating = False
   .DisplayAlerts = False
   .EnableEvents = False
End With

'===pour éviter le fichier "sommaire" (nommé "asommaire" pour être en premier)
Fich = Dir(ThisWorkbook.Path & "\" & "*.xls")
Do While Not Fich Like "Xx*"
   Fich = Dir
Loop
Num = Split(Fich, "_")

With ThisWorkbook.Sheets("Sommaire")
   '===pour afficher toutes les données
   If .FilterMode = True Then .ShowAllData
   '===Première ligne vide
   .Cells(.[B65536].End(xlUp).Row + 1, 2).Activate
   On Error Resume Next
   For i = 2 To .[B65536].End(xlUp).Row
      With Cells(i, 1)
         '===construction du nom de fichier
         Fich = Dir(ThisWorkbook.Path & "\" & Num(0) & "_" & Format(.Value, "0000") & "*.xls")
         Cible = IIf(.Hyperlinks.Count = 1, ThisWorkbook.Path & "\" & .Hyperlinks(1).Address, Fich)
         If Dir(Cible) = "" Then MsgBox "Faire une mise à jour des liens" & vbLf & "Fichier concerné = "&                .Hyperlinks(1).Address:Exit For
      End With
   Next i
End With

With Application
   .ScreenUpdating = True
   .DisplayAlerts = True
   .EnableEvents = True
End With

End Sub

donc, je construis le nom du fichier matériel cible à partir de son numéro de série (le seul élément qui apparaît dans la cellule) puis je vérifie son existence dans le répertoire, s'il existe je passe au suivant sinon j'arrête la macro et demande une mise à jour.

mon soucis c'est que j'ai mis ce code dans "Worksbook_Open", avec quelques fichiers cible, c'est instantané, avec 1000 ça devient plus long (encore acceptable) mais avec 15000, ça coince, le temps d'ouverture du fichier devient prohibitif

me question est simple (la réponse...):
est t'il possible d’accélérer cette macro ?

cordialement

 

[Jam]

Re : Accélérer code + liens hypertexte

Salut francedemo,

Ce qui "coûte" le plus en terme de traitement dans un programme c'est la lecture/écriture d'une cellule. Bon dans ton cas, la lecture d'un répertoire de 15000 fichier doit prendre pas mal de temps aussi.
Le meilleur (c'est prétentieux désolé) conseil que je puisse te donner c'est de travailler à partir de tableau en mémoire.
1. Je mets mes données en mémoire
2. je traite le tableau
3. je transfert les données du tableau dans le fichier

Cette méthode est particulièrement rapide car on lit des données en mémoire, ce qui est nettement plus rapide que de lire une cellule.

Autre piste: Tu peux d'abord charger le contenu du directory dans un tableau ou ton classeur, puis ensuite te lancer dans la vérif de tes liens.

Voilà, j'espère que cela t'aidera un peu.
Bon courage

 

[francedemo]

Re : Accélérer code + liens hypertexte

merci jam pour ta réponse,
j'ai bien pensé passer par un tableau, mais je ne sais faire la recopie dans le fichier pour que ce soient des liens hypertexte...
sinon, comment tu fais pour charger le contenu du répertoire dans un tableau ?

par ce que le soucis vient aussi du fait que ledit répertoire est sur le réseau, donc les temps d'accès ne sont pas maîtrisés.

je vais chercher de ce coté.

 

[Jam]

Re : Accélérer code + liens hypertexte

re,

Tu trouveras ci-après un bout de code qui lit une sélection (à adapter à ton cas) et qui vérifie pour chaque cellule que le lien (le fichier donc) existe bien.
Ce code repose sur l'utilisation d'une API qui est censée être très rapide. A vérifier dans le cas de la lecture d'un répertoire avec 15000 fichiers.
J'ai ajouté, dans le cas où le lien est inconnu, la sélection de la cellule concernée

Option Explicit


'// FileExists() \\
Declare Function PathFileExists Lib "shlwapi" _
    Alias "PathFileExistsA" (ByVal strFile As String) As Long
    
Sub test()
'Dim myRange As Range    inutile
Dim x As Range

With Application
   .ScreenUpdating = False
   .DisplayAlerts = False
   .EnableEvents = False
   .Calculation = xlCalculationManual   '# Evite le lancement du calcul du classeur
End With

'Set myRange = Selection  inutile

For Each x In Selection
'For Each x In myRange
    If Not FileExists(x.Hyperlinks(1).Address) Then
        MsgBox "Attention le fichier " & vbCrLf & x.Hyperlinks(1).Address & vbCrLf & "n'existe plus. Merci de le mettre à jour", vbExclamation + vbOKOnly, "Mise à jour fichier"
        x.Select
        Exit For
    End If
Next

'Set myRange = Nothing    inutile

With Application
   .ScreenUpdating = True
   .DisplayAlerts = True
   .EnableEvents = True
   .Calculation = xlCalculationAutomatic   '# Rétablit le calcul automatic
End With

End Sub


'=========================================================
'Fonction (très rapide) vérifiant l'existence d'un fichier
'=========================================================
Public Function FileExists(strFile As String) As Boolean
  FileExists = PathFileExists(strFile)
End Function

Bon courage.


modif: j'ai modifié le code en retirant 3 lignes inutiles

 

[francedemo]

Re : Accélérer code + liens hypertexte

merci Jam pour ce code
je n'ai pas le temps de le tester aujourd'hui
je regarderai ça demain avec les adaptations à mon besoin
je te redis ce que ça donne
à +