oguruma
XLDnaute Impliqué
bnjr, et.. précision des sous-répertoires à 6 niveaux en profondeur 🙂
Icône de la ressource
Index de vos Macros avec Mots-Clés V1.2
- Initiateur de la discussion crocrocro
- Date de début
Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !
bonjour
bravo. mon problème est avec le nom court (celui du fichier ouvert à fermer) et avec le nom complet du fichier xslm ou il manque assez régulièrement l'identification du dossier de départ dans l'hyperlink mais pas tout de suite cela fonctionne et au bout d'un moment cela ne fonctione plus . Je vais voir ça.
En fait la première fois cela fonctionne
Ensuite si on ferme et réouvre, c'est la que les liens ne sont plus bons
Dernière édition:
oguruma
XLDnaute Impliqué
Disons que pour mes propres besoins sans démonter cet excellent travail je vais y replacer le nom d'origine avec les dossiers car ça va être un de mes critères pour supprimer les doublons, je mettrai certainement la date de dernières modification que je récupérerai dans les attributs du fichiers pour ne retenir le dernier mis à jour... cas des fichiers en versionning par exemple... je ne cache pas que je referai peut-être une partie du code existant que je publierai avec l'accord de l'auteur - c'est ce que l'on appelle le développement collaboratif 🙂
En fait come déja dit :
En fait la première fois cela fonctionne
Ensuite si on ferme et réouvre, c'est la que les liens en colonne A ne sont plus bons
aussi je les récupére en lançant cette macro : Re_Ecrire_Hyperlink
Sub Re_Ecrire_Hyperlink()
Dim AAA As Integer, HL As String, New_HL As String
AAA = 4: Ex_HL = ""
For Each h In Cells.Hyperlinks
HL = h.Address ' Récupère le lien
' If Ex_HL <> HL Then
New_HL = retablir_lien(HL, AAA)
h.Address = Replace(h.Address, HL, New_HL)
' Debug.Print "Col = A ligne="; AAA, HL, New_HL ' = "dwhelper/JC_ASTRO_SWE64_der.xlsm "
' AAA = AAA + 1: Ex_HL = HL ' MsgBox HL ' Affiche le chemin du lien
' End If
Next
End Sub
Function retablir_lien(ByVal Q_lien As String, Q_Ligne As Integer) As String
Q_Dossier = Sheets("Liste Procédures").Cells(1, 1) ' D:\DOWNLOAD_D\dwhelper
NomsousDossier = Mid(Q_Dossier, InStrRev(Q_Dossier, "\") + 1) ' dwhelper
xx = Len(NomsousDossier) ' 8
Nom_du_Dossier = Mid(Q_Dossier, 1, Len(Q_Dossier) - (xx + 0))
Nom_du_Dossier = Replace(Nom_du_Dossier, "\", "/")
'' Debug.Print "Q_Dossier="; Q_Dossier, "NomsousDossier="; NomsousDossier, xx, "Nom_du_Dossier="; Nom_du_Dossier
If NomsousDossier = Left(Q_lien, xx) Then
retablir_lien = Nom_du_Dossier & Q_lien
' modifier le lien colonne A
End If
En fait la première fois cela fonctionne
Ensuite si on ferme et réouvre, c'est la que les liens en colonne A ne sont plus bons
aussi je les récupére en lançant cette macro : Re_Ecrire_Hyperlink
Sub Re_Ecrire_Hyperlink()
Dim AAA As Integer, HL As String, New_HL As String
AAA = 4: Ex_HL = ""
For Each h In Cells.Hyperlinks
HL = h.Address ' Récupère le lien
' If Ex_HL <> HL Then
New_HL = retablir_lien(HL, AAA)
h.Address = Replace(h.Address, HL, New_HL)
' Debug.Print "Col = A ligne="; AAA, HL, New_HL ' = "dwhelper/JC_ASTRO_SWE64_der.xlsm "
' AAA = AAA + 1: Ex_HL = HL ' MsgBox HL ' Affiche le chemin du lien
' End If
Next
End Sub
Function retablir_lien(ByVal Q_lien As String, Q_Ligne As Integer) As String
Q_Dossier = Sheets("Liste Procédures").Cells(1, 1) ' D:\DOWNLOAD_D\dwhelper
NomsousDossier = Mid(Q_Dossier, InStrRev(Q_Dossier, "\") + 1) ' dwhelper
xx = Len(NomsousDossier) ' 8
Nom_du_Dossier = Mid(Q_Dossier, 1, Len(Q_Dossier) - (xx + 0))
Nom_du_Dossier = Replace(Nom_du_Dossier, "\", "/")
'' Debug.Print "Q_Dossier="; Q_Dossier, "NomsousDossier="; NomsousDossier, xx, "Nom_du_Dossier="; Nom_du_Dossier
If NomsousDossier = Left(Q_lien, xx) Then
retablir_lien = Nom_du_Dossier & Q_lien
' modifier le lien colonne A
End If
Bonsoir,
j'ai effectué les tests suivants :
- ouverture d'un fichier du tableau à partir du lien hypertexte
- fermeture du fichier
- ouverture du même fichier à partir du lien hypertexte
- fermeture de mon fichier
- réouverture de mon fichier
- ouverture d'un fichier du tableau à partir du lien hypertexte
- fermeture du fichier
- ouverture du même fichier à partir du lien hypertexte
et je n'ai rencontré aucun problème.
Les liens hypertextes en colonne A sont statiques.
Désolé, mais je ne vois pas.
Quelqu'un d'autre a-t-il rencontré ce problème ?
Accord signé en 3 exemplaires 😀
Peut être que je manque de précision et que ce que j'ai dit s'interpréte de 2 façons.
1 ouverture du classeur
. choix du répertoire ok
. lister les procédures ok
-accès aux fichiers de la colonne A via hypertexte plusieurs fois ok
-accès au formulaire appelé par les autres colonnes via leur lien hypertexte plusieurs fois ok
tout fonctionne ok.
j'appelle par vba le lien de la ligne A11
? range("A11").Hyperlinks(1).Address
D:\DOWNLOAD_D\dwhelper\JC_ASTRO_SWE64_der.xlsm
maintenant je ferme le classeur en l'enregistrant
2 Je l'enregistre et je le ferme.
4 Je réouvre le classeur qui contient toujours les données
et dans la colonne A le lien est toujours bon, le classeur appelé s'ouvre correctement
par contre
je rappelle par vba le lien de la ligne A11
? range("A11").Hyperlinks(1).Address
dwhelper\JC_ASTRO_SWE64_der.xlsm
il manque le dossier de départ ce qui fait que le formulaire appelé par autres colonnes ne peut pas s'ouvrir
Bonjour jclaborde,
je viens, avec vos dernières précisions, de reproduire le problème.
Un bizarrerie (pour ne pas dire anomalie) d'Excel qui perd dans la propriété HyperLinks(1).Name (ou .Address) le chemin complet du lien si on ferme le fichier.
Exemple :
C:\Users\Default\Documents\Test Remplacer dans le code VBA\Fichier1.xlsm
donne
Test Remplacer dans le code VBA/Fichier1.xlsm.
Pour y remédier et aussi pour connaitre le nom complet du fichier sans survoler le lien en colonne A, j'ai ajouté une colonne Nom Fichier Complet à la fin du tableau.
Merci pour le signalement.
Bonjour,
le pb est connu et fait l'objet d'une discussion ici par Dudu2
Comment empêcher Excel de modifier les liens Hypertexte à l'enregistrement
citations résumées
Bernard XLD dit
Option d'application
Fichier/Options/Options avancées/Options Web,
décocher "mettre à jour les liens avant enregistrement"
en vba
Application.DefaultWebOptions.UpdateLinksOnSave = False
Dudu2
Le problème c'est que c'est une option Application et non Workbook.
Donc elle va rester permanente. Mais à la limite je trouve que c'est mieux car Excel n'a pas à bricoler les Hyperliens.
En tous cas, quand c'est fait manuellement, l'effet est aussi général.
Dans le pire des cas, si on veut ne pas impacter les options par défaut ou courantes:
CODE:
'https://www.excel-downloads.com/thr...s-liens-hypertexte-a-lenregistrement.20057520
Dim UpdateLinksOnSave As Boolean
'Sauvegarde de l'option Fichier/Options/Options avancées/Options Web/"Mettre à jour les liens avant enregistrement"
UpdateLinksOnSave = Application.DefaultWebOptions.UpdateLinksOnSave
'False pour éviter de rendre relatifs les liens partageant le même chemin que le classeur
Application.DefaultWebOptions.UpdateLinksOnSave = False
'-------------------------
'Enregistrement du fichier
'-------------------------
ThisWorkbook.Save
'Restoration de l'option Fichier/Options/Options avancées/Options Web/"Mettre à jour les liens avant enregistrement"
Application.DefaultWebOptions.UpdateLinksOnSave = UpdateLinksOnSave
le pb est connu et fait l'objet d'une discussion ici par Dudu2
Comment empêcher Excel de modifier les liens Hypertexte à l'enregistrement
citations résumées
Bernard XLD dit
Option d'application
Fichier/Options/Options avancées/Options Web,
décocher "mettre à jour les liens avant enregistrement"
en vba
Application.DefaultWebOptions.UpdateLinksOnSave = False
Dudu2
Le problème c'est que c'est une option Application et non Workbook.
Donc elle va rester permanente. Mais à la limite je trouve que c'est mieux car Excel n'a pas à bricoler les Hyperliens.
En tous cas, quand c'est fait manuellement, l'effet est aussi général.
Dans le pire des cas, si on veut ne pas impacter les options par défaut ou courantes:
CODE:
'https://www.excel-downloads.com/thr...s-liens-hypertexte-a-lenregistrement.20057520
Dim UpdateLinksOnSave As Boolean
'Sauvegarde de l'option Fichier/Options/Options avancées/Options Web/"Mettre à jour les liens avant enregistrement"
UpdateLinksOnSave = Application.DefaultWebOptions.UpdateLinksOnSave
'False pour éviter de rendre relatifs les liens partageant le même chemin que le classeur
Application.DefaultWebOptions.UpdateLinksOnSave = False
'-------------------------
'Enregistrement du fichier
'-------------------------
ThisWorkbook.Save
'Restoration de l'option Fichier/Options/Options avancées/Options Web/"Mettre à jour les liens avant enregistrement"
Application.DefaultWebOptions.UpdateLinksOnSave = UpdateLinksOnSave
oguruma
XLDnaute Impliqué
Bjr et pour faire simple et se libérer de toutes ces contraintes et source d'ennuis pourquoi ne pas mettre le chemin complet du fichier puis faire appel à l'événement DoubleClic dans la cellule et ouvrir le fichier..... Cela aurait été l'option que j'aurai retenu et de plus ça va éviter la reconstruction du chemin du fichier sous forme de lien web et donc moins de code 😉 comme je peux le voir dans le code... avec la gestion "nom long" et "nom court" 🙂Bonjour,
le pb est connu et fait l'objet d'une discussion ici par Dudu2
Comment empêcher Excel de modifier les liens Hypertexte à l'enregistrement
citations résumées
Bernard XLD dit
Option d'application
Fichier/Options/Options avancées/Options Web,
décocher "mettre à jour les liens avant enregistrement"
en vba
Application.DefaultWebOptions.UpdateLinksOnSave = False
Dudu2
Le problème c'est que c'est une option Application et non Workbook.
Donc elle va rester permanente. Mais à la limite je trouve que c'est mieux car Excel n'a pas à bricoler les Hyperliens.
En tous cas, quand c'est fait manuellement, l'effet est aussi général.
Dans le pire des cas, si on veut ne pas impacter les options par défaut ou courantes:
CODE:
'https://www.excel-downloads.com/thr...s-liens-hypertexte-a-lenregistrement.20057520
Dim UpdateLinksOnSave As Boolean
'Sauvegarde de l'option Fichier/Options/Options avancées/Options Web/"Mettre à jour les liens avant enregistrement"
UpdateLinksOnSave = Application.DefaultWebOptions.UpdateLinksOnSave
'False pour éviter de rendre relatifs les liens partageant le même chemin que le classeur
Application.DefaultWebOptions.UpdateLinksOnSave = False
'-------------------------
'Enregistrement du fichier
'-------------------------
ThisWorkbook.Save
'Restoration de l'option Fichier/Options/Options avancées/Options Web/"Mettre à jour les liens avant enregistrement"
Application.DefaultWebOptions.UpdateLinksOnSave = UpdateLinksOnSave
Bonjour Oguruma,
c'est ce que j'ai fait par ajout d'une colonne Nom complet (voir post #23).
A l'origine, je voulais avoir le tableau entier sur la page sans avoir à scroller (au survol du lien hypertexte en colonne A on retrouvait si besoin le chemin complet du fichier).
oguruma
XLDnaute Impliqué
Bonsoir CroCroCro,
Pour donner suite à nos échanges de développement sachant que je te proposais une variante préparatoire via PowerQuery voici un peu l'orientation de la future version.
Contrairement à ta version où tu sélectionnes le répertoire à traiter que tu mémorises dans un tableau en mémoire pour ensuite analyser les fichiers et présenter les Macros dans un tableau (TS) résultat, je passe au préalable par PowerQuery.
Via PowerQuery :
- sélection du dossier
- option des sous-dossiers (pour respecter ta version)
- type de fichiers retenus pour l'analyse .xlsm, .xlsb, ou les deux
- critères de sélection sur les différentes dates systèmes
- et petite cerise sur le "gâteau" deux critères de tri
puis ensuite on lance la requête
afin de produire le tableau ci-dessous.
Ainsi on peut affiner par itération si nécessaire quels seront les fichiers à inventorier
Par cette méthode on a une vue précise sur les fichiers que l'on va examiner.
Je vais certainement ajouter une colonne au bout du tableau qui permettra encore une analyse plus fine afin de déterminer si on prend réellement le(s) fichier(s) renvoyé(s) par la requête Pwq. En effet il est possible que dans l'inventaire produit que des fichiers ne soient pas intéressants à retenir (eg. cas du versionning)
Pour l'inventaire je reprendrai une partie de ton code... pas la peine de recoder ce qui fonctionne bien avec certainement quelques personnalisations pour l'adapter au nouveau mode présentation des résultats.
Cet inventaire consistera donc à balayer le tableau résultat de la requête Pwq et éventuellement tenir compte du critère de rétention que j'aurai ajouté et ensuite de procéder à l'inventaire des macros des fichiers réellement retenus pour l'inventaire final.
Bon pour l'instant c'est encore en chantier, il faut déjà que je finalise et sécurise la partie sélection des fichiers en PowerQuery car c'est une des conditions essentielles du bon fonctionnement de cette future V2.
Merci pour les droits d'auteurs que tu m'as accordé pour récupérer ton code. 🙂
en avance de phase la V0 de la requête Pwq qui reste encore à sécuriser "blinder"
Pour donner suite à nos échanges de développement sachant que je te proposais une variante préparatoire via PowerQuery voici un peu l'orientation de la future version.
Contrairement à ta version où tu sélectionnes le répertoire à traiter que tu mémorises dans un tableau en mémoire pour ensuite analyser les fichiers et présenter les Macros dans un tableau (TS) résultat, je passe au préalable par PowerQuery.
Via PowerQuery :
- sélection du dossier
- option des sous-dossiers (pour respecter ta version)
- type de fichiers retenus pour l'analyse .xlsm, .xlsb, ou les deux
- critères de sélection sur les différentes dates systèmes
- et petite cerise sur le "gâteau" deux critères de tri
puis ensuite on lance la requête
Ainsi on peut affiner par itération si nécessaire quels seront les fichiers à inventorier
Par cette méthode on a une vue précise sur les fichiers que l'on va examiner.
Je vais certainement ajouter une colonne au bout du tableau qui permettra encore une analyse plus fine afin de déterminer si on prend réellement le(s) fichier(s) renvoyé(s) par la requête Pwq. En effet il est possible que dans l'inventaire produit que des fichiers ne soient pas intéressants à retenir (eg. cas du versionning)
Pour l'inventaire je reprendrai une partie de ton code... pas la peine de recoder ce qui fonctionne bien avec certainement quelques personnalisations pour l'adapter au nouveau mode présentation des résultats.
Cet inventaire consistera donc à balayer le tableau résultat de la requête Pwq et éventuellement tenir compte du critère de rétention que j'aurai ajouté et ensuite de procéder à l'inventaire des macros des fichiers réellement retenus pour l'inventaire final.
Bon pour l'instant c'est encore en chantier, il faut déjà que je finalise et sécurise la partie sélection des fichiers en PowerQuery car c'est une des conditions essentielles du bon fonctionnement de cette future V2.
Merci pour les droits d'auteurs que tu m'as accordé pour récupérer ton code. 🙂
en avance de phase la V0 de la requête Pwq qui reste encore à sécuriser "blinder"
PowerQuery:
let
STR_TYPE_FICHIER = Excel.CurrentWorkbook(){[Name="LB_TYPE_FICHIER"]}[Content]{0}[Column1],
STR_NOM_DOSSIER = Excel.CurrentWorkbook(){[Name="NOM_DOSSIER"]}[Content]{0}[Column1],
STR_SOUS_DOSSIER = Excel.CurrentWorkbook(){[Name="CB_SOUS_DOSSIER"]}[Content]{0}[Column1],
DATE_DATE_CREATION = Excel.CurrentWorkbook(){[Name="DATE_CREATION"]}[Content]{0}[Column1],
DATE_DATE_DERN_MODIF = Excel.CurrentWorkbook(){[Name="DATE_DERN_MODIF"]}[Content]{0}[Column1],
DATE_DERNIER_ACCES= Excel.CurrentWorkbook(){[Name="DATE_DERNIER_ACCES"]}[Content]{0}[Column1],
STR_crit1=Excel.CurrentWorkbook(){[Name="LB_CRIT_TRI_1"]}[Content]{0}[Column1],
STR_crit2=Excel.CurrentWorkbook(){[Name="LB_CRIT_TRI_2"]}[Content]{0}[Column1],
crit1=if STR_crit1="<AUCUN>" then null else STR_crit1,
crit2=if STR_crit2="<AUCUN>" then null else STR_crit2,
pcrit1=if crit1 is null then null else "{{""" & crit1 & """, 0}}",
pcrit2=if crit2 is null then pcrit1 else if pcrit1 is null then "{{""" & crit2 & """, 0}}" else "{{""" & crit1 & """, 0}" & ", {""" & crit2 & """, 0}}",
evCritTri=if pcrit2 is null then null else Expression.Evaluate(pcrit2),
Source = Folder.Files(STR_NOM_DOSSIER),
TBL_SUPPR_COL_CONTENT = Table.RemoveColumns(Source,{"Content"}),
TBL_FILTRE_SOUS_DOSSIERS = if not STR_SOUS_DOSSIER then
Table.SelectRows(TBL_SUPPR_COL_CONTENT, each [Folder Path] = STR_NOM_DOSSIER & "\")
else
TBL_SUPPR_COL_CONTENT,
TBL_FILTRE_TYPE_FICHIER = if STR_TYPE_FICHIER ="XLSM + XLSB" then
Table.SelectRows(TBL_FILTRE_SOUS_DOSSIERS, each [Extension] = ".xlsm" or [Extension] = ".xlsb")
else if STR_TYPE_FICHIER ="XLSM" then
Table.SelectRows(TBL_FILTRE_SOUS_DOSSIERS, each [Extension] = ".xlsm")
else if STR_TYPE_FICHIER ="XLSB" then
Table.SelectRows(TBL_FILTRE_SOUS_DOSSIERS, each [Extension] = ".xlsb")
else
null,
TBL_FILTRE_DATE_1= if DATE_DATE_CREATION is null then
TBL_FILTRE_TYPE_FICHIER
else
Table.SelectRows(TBL_FILTRE_TYPE_FICHIER, each Date.From([Date created])= Date.From(DATE_DATE_CREATION)),
TBL_FILTRE_DATE_2= if DATE_DATE_DERN_MODIF is null then
TBL_FILTRE_DATE_1
else
Table.SelectRows(TBL_FILTRE_TYPE_FICHIER, each Date.From([Date modified])= Date.From(DATE_DATE_DERN_MODIF)),
TBL_FILTRE_DATE_3= if DATE_DERNIER_ACCES is null then
TBL_FILTRE_DATE_2
else
Table.SelectRows(TBL_FILTRE_TYPE_FICHIER, each Date.From([Date accessed])= Date.From(DATE_DERNIER_ACCES)),
TBL_TRI = if evCritTri is null then TBL_FILTRE_DATE_3 else Table.Sort(TBL_FILTRE_DATE_3,evCritTri)
in
TBL_TRI
Dernière édition:
Bonne idée
Perso j'ai déja ajouté les dates de création, de dernière modif et de dernier accès en fin de tableau
Au départ je pensais m'en servir pour 1 supprimer les versions obsolettes et 2 pour comparer le code de 2 versions, celle en développement et celle en "production" en exportant les modules présentant des différences pour les injecter dans un comparateur de texte intelligent avec les deux versions cote à cote et les différences indiquées par des couleurs et des possibilité de fusion etc, comme BeyondCompare. (https://www.scootersoftware.com/home/gallery)
Cependant c'est un plus gros boulot que je ne pensais.
Je suis intéréssé par la suite.
Bonjour Oguruma, Jclaborde
une évolution buissonnante, ainsi va la vie du code VBA comme celle du code génétique...
Oguruma, j'ai vu ailleurs que PowerQuery était ton dada, alors que la Power soit avec toi 😉
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Discussions similaires
