Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.
Icône de la ressource

Index de vos Macros avec Mots-Clés V1.2

Inscrivez vous pour télécharger ce fichier
  • Initiateur de la discussion Initiateur de la discussion crocrocro
  • Date de début Date de début
Vue principale Avis (1) Historique Discussion

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 !

S'inscrire
oguruma à dit:
bnjr, et.. précision des sous-répertoires à 6 niveaux en profondeur 🙂
Cliquez pour agrandir...
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:
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
 

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 ?
 
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

XL 2016 Discussion 'VBA - Comment empêcher Excel de modifier les liens Hypertexte à l'enregistrement'

Bonjour,

Lorsque le lien hypertexte et le classeur partagent le même début de chemin absolu, à l'enregistrement du classeur, Excel supprime la partie commune du chemin du lien hypertexte qui devient alors un chemin relatif. Et franchement de quoi se mêle-t-il ?!

Car si on utilise ces hyperliens dans un autre contexte (déplacement du classeur, utilisation par un autre classeur), leur relativité n'est plus valable et les liens sont évidemment inopérants.

Démonstration de la modification par Excel des Hyperliens dans le fichier joint.
Et demande d'aide pour savoir si on peut contourner...

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
 
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 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).
 
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"

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 😉
 
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- 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

Discussions similaires

EXCEL :: LIBMAC
Réponses
11
Affichages
636
oguruma
C
Rechercher et Remplacer avec respect des caractéristiques de Police
Réponses
0
Affichages
126
crocrocro
C
Créez votre propre moteur de recherche pour vos recettes de cuisine en HTML !
Réponses
1
Affichages
635
dysorthographie
M
[REF] Wiki Page 8 de MichelXld
Réponses
0
Affichages
39 K
MichelXld
M
M
[REF] Wiki 6 de MichelXld (Doublons, Tris, Filtres, Variables, Fichiers fermés, Acces
Réponses
0
Affichages
68 K
MichelXld
M
M
[REF] Wiki 5 de MichelXld (Formules, Audits de formules, Répertoires, Fichiers)
Réponses
0
Affichages
47 K
MichelXld
M
M
[REF] Wiki Page 7 de MichelXld
Réponses
0
Affichages
51 K
MichelXld
M
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…