Lien vers un répertoire en particulier

Le
Gaspareau
Bonjour,

J'ai récupéré, sur Excelabo je crois, la macro suivante
qui me crée un fichier avec des liens hypertexte vers les
fichiers inclus dans un répertoire nommé

Cependant je dois aller éditer la macro lorsque je veux la
même chose vers un autre répertoire.

J'ai tenté de trouver depuis hier, sans succès vous l'avez deviné, de
modifier
cette macro afin d'avoir un messagebox qui me demanderait
quel répertoire je veux "hypertexter". Je me tourne donc vers vous

Autrement dit je veux pouvoir changer via un message box le
F:3 TRAVAUX PUBLICSGeomatiqueBase de Donnees
de mon exemple ci-joint.

Voici le code que j'utilise

Merci d'avance


Rem Attribute VB_Name = "AfficherFichiersHypertexte"

Dim I As Long, J As Integer
'ce code, tel qu'il est rédigé, nécessite que la librairie
'Microsoft Scripting Runtime soit cochée dans OutilRéférences
'pour fonctionner.
'sinon, FileSystemObject, Folder, Files ne sont pas reconus
'et doivent être déclarés As Object

Sub creerlienshypertexte()
'dans l'appel à GetFolder, il faut un antislash final
Dim racine
racine = "F:3 TRAVAUX PUBLICSGeomatiqueBase de Donnees"
Repertoire (racine)
End Sub

Sub Repertoire(rep$)
'ajoute une feuille au classeur actif, appelle la procédure
'récursive à partir du dossier racine de la recherche (rep)
'met en forme la colonne des résultats
Application.ScreenUpdating = False
Sheets.Add
I = 1: J = 1
With New FileSystemObject
dany .GetFolder(rep) 'GetFolder requiert un antislash final
End With
ActiveSheet.UsedRange.EntireColumn.AutoFit
ActiveWindow.Zoom = 80

End Sub

Private Sub dany(ByVal F As Folder)
'd'après L Longre
'boucle sur les dossiers et sous dossiers de F
'écrit les noms et chemins complets des fichiers
'trouvés dans la colonne A d'une feuille de calcul
'crée un lien hypertexte vers chaque fichier
If F.SubFolders.Count Then
Dim SF As Folder
For Each SF In F.SubFolders
Dim Fichiers As Files
Set Fichiers = SF.Files
For Each file In Fichiers
I = I + 1
Cells(I, J) = file.Path
ActiveWorkbook.ActiveSheet.Hyperlinks.Add _
Anchor:Îlls(I, J), Address:=file.Path
Next file
dany SF
Next SF
End If
End Sub

Merci
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
isabelle
Le #4221571
bonjour Gaspareau,

With Application.FileDialog(msoFileDialogFolderPicker)
.Show
répertoire = .SelectedItems(1)
End With

isabelle


Bonjour,

J'ai récupéré, sur Excelabo je crois, la macro suivante
qui me crée un fichier avec des liens hypertexte vers les
fichiers inclus dans un répertoire nommé

Cependant je dois aller éditer la macro lorsque je veux la
même chose vers un autre répertoire.

J'ai tenté de trouver depuis hier, sans succès vous l'avez deviné, de
modifier
cette macro afin d'avoir un messagebox qui me demanderait
quel répertoire je veux "hypertexter". Je me tourne donc vers vous...

Autrement dit je veux pouvoir changer via un message box le
F:3 TRAVAUX PUBLICSGeomatiqueBase de Donnees
de mon exemple ci-joint.

Voici le code que j'utilise

Merci d'avance


Rem Attribute VB_Name = "AfficherFichiersHypertexte"

Dim I As Long, J As Integer
'ce code, tel qu'il est rédigé, nécessite que la librairie
'Microsoft Scripting Runtime soit cochée dans OutilRéférences
'pour fonctionner.
'sinon, FileSystemObject, Folder, Files ne sont pas reconus
'et doivent être déclarés As Object

Sub creerlienshypertexte()
'dans l'appel à GetFolder, il faut un antislash final
Dim racine
racine = "F:3 TRAVAUX PUBLICSGeomatiqueBase de Donnees"
Repertoire (racine)
End Sub

Sub Repertoire(rep$)
'ajoute une feuille au classeur actif, appelle la procédure
'récursive à partir du dossier racine de la recherche (rep)
'met en forme la colonne des résultats
Application.ScreenUpdating = False
Sheets.Add
I = 1: J = 1
With New FileSystemObject
dany .GetFolder(rep) 'GetFolder requiert un antislash final
End With
ActiveSheet.UsedRange.EntireColumn.AutoFit
ActiveWindow.Zoom = 80

End Sub

Private Sub dany(ByVal F As Folder)
'd'après L Longre
'boucle sur les dossiers et sous dossiers de F
'écrit les noms et chemins complets des fichiers
'trouvés dans la colonne A d'une feuille de calcul
'crée un lien hypertexte vers chaque fichier
If F.SubFolders.Count Then
Dim SF As Folder
For Each SF In F.SubFolders
Dim Fichiers As Files
Set Fichiers = SF.Files
For Each file In Fichiers
I = I + 1
Cells(I, J) = file.Path
ActiveWorkbook.ActiveSheet.Hyperlinks.Add _
Anchor:Îlls(I, J), Address:=file.Path
Next file
dany SF
Next SF
End If
End Sub

Merci




Gaspareau
Le #4221501
Merci Isabelle d'avoir pris le temps de me répondre
mais ça ne semble pas fonctionner.
La fenêtre qui est appelée me permet de choisir un fichier,
pas un répertoire.

Ou je ne fais pas la bonne manipulation..

"isabelle" a écrit dans le message de
news:
bonjour Gaspareau,

With Application.FileDialog(msoFileDialogFolderPicker)
.Show
répertoire = .SelectedItems(1)
End With

isabelle


Bonjour,

J'ai récupéré, sur Excelabo je crois, la macro suivante
qui me crée un fichier avec des liens hypertexte vers les
fichiers inclus dans un répertoire nommé

Cependant je dois aller éditer la macro lorsque je veux la
même chose vers un autre répertoire.

J'ai tenté de trouver depuis hier, sans succès vous l'avez deviné, de
modifier
cette macro afin d'avoir un messagebox qui me demanderait
quel répertoire je veux "hypertexter". Je me tourne donc vers vous...

Autrement dit je veux pouvoir changer via un message box le
F:3 TRAVAUX PUBLICSGeomatiqueBase de Donnees
de mon exemple ci-joint.

Voici le code que j'utilise

Merci d'avance


Rem Attribute VB_Name = "AfficherFichiersHypertexte"

Dim I As Long, J As Integer
'ce code, tel qu'il est rédigé, nécessite que la librairie
'Microsoft Scripting Runtime soit cochée dans OutilRéférences
'pour fonctionner.
'sinon, FileSystemObject, Folder, Files ne sont pas reconus
'et doivent être déclarés As Object

Sub creerlienshypertexte()
'dans l'appel à GetFolder, il faut un antislash final
Dim racine
racine = "F:3 TRAVAUX PUBLICSGeomatiqueBase de Donnees"
Repertoire (racine)
End Sub

Sub Repertoire(rep$)
'ajoute une feuille au classeur actif, appelle la procédure
'récursive à partir du dossier racine de la recherche (rep)
'met en forme la colonne des résultats
Application.ScreenUpdating = False
Sheets.Add
I = 1: J = 1
With New FileSystemObject
dany .GetFolder(rep) 'GetFolder requiert un antislash final
End With
ActiveSheet.UsedRange.EntireColumn.AutoFit
ActiveWindow.Zoom = 80

End Sub

Private Sub dany(ByVal F As Folder)
'd'après L Longre
'boucle sur les dossiers et sous dossiers de F
'écrit les noms et chemins complets des fichiers
'trouvés dans la colonne A d'une feuille de calcul
'crée un lien hypertexte vers chaque fichier
If F.SubFolders.Count Then
Dim SF As Folder
For Each SF In F.SubFolders
Dim Fichiers As Files
Set Fichiers = SF.Files
For Each file In Fichiers
I = I + 1
Cells(I, J) = file.Path
ActiveWorkbook.ActiveSheet.Hyperlinks.Add _
Anchor:Îlls(I, J), Address:=file.Path
Next file
dany SF
Next SF
End If
End Sub

Merci






isabelle
Le #4221431
re bonjour Gaspareau,

voici un exemple :

http://cjoint.com/?cBrCr5CrJ5

isabelle


Merci Isabelle d'avoir pris le temps de me répondre
mais ça ne semble pas fonctionner.
La fenêtre qui est appelée me permet de choisir un fichier,
pas un répertoire.

Ou je ne fais pas la bonne manipulation..

"isabelle" a écrit dans le message de
news:

bonjour Gaspareau,

With Application.FileDialog(msoFileDialogFolderPicker)
.Show
répertoire = .SelectedItems(1)
End With

isabelle



Bonjour,

J'ai récupéré, sur Excelabo je crois, la macro suivante
qui me crée un fichier avec des liens hypertexte vers les
fichiers inclus dans un répertoire nommé

Cependant je dois aller éditer la macro lorsque je veux la
même chose vers un autre répertoire.

J'ai tenté de trouver depuis hier, sans succès vous l'avez deviné, de
modifier
cette macro afin d'avoir un messagebox qui me demanderait
quel répertoire je veux "hypertexter". Je me tourne donc vers vous...

Autrement dit je veux pouvoir changer via un message box le
F:3 TRAVAUX PUBLICSGeomatiqueBase de Donnees
de mon exemple ci-joint.

Voici le code que j'utilise

Merci d'avance


Rem Attribute VB_Name = "AfficherFichiersHypertexte"

Dim I As Long, J As Integer
'ce code, tel qu'il est rédigé, nécessite que la librairie
'Microsoft Scripting Runtime soit cochée dans OutilRéférences
'pour fonctionner.
'sinon, FileSystemObject, Folder, Files ne sont pas reconus
'et doivent être déclarés As Object

Sub creerlienshypertexte()
'dans l'appel à GetFolder, il faut un antislash final
Dim racine
racine = "F:3 TRAVAUX PUBLICSGeomatiqueBase de Donnees"
Repertoire (racine)
End Sub

Sub Repertoire(rep$)
'ajoute une feuille au classeur actif, appelle la procédure
'récursive à partir du dossier racine de la recherche (rep)
'met en forme la colonne des résultats
Application.ScreenUpdating = False
Sheets.Add
I = 1: J = 1
With New FileSystemObject
dany .GetFolder(rep) 'GetFolder requiert un antislash final
End With
ActiveSheet.UsedRange.EntireColumn.AutoFit
ActiveWindow.Zoom = 80

End Sub

Private Sub dany(ByVal F As Folder)
'd'après L Longre
'boucle sur les dossiers et sous dossiers de F
'écrit les noms et chemins complets des fichiers
'trouvés dans la colonne A d'une feuille de calcul
'crée un lien hypertexte vers chaque fichier
If F.SubFolders.Count Then
Dim SF As Folder
For Each SF In F.SubFolders
Dim Fichiers As Files
Set Fichiers = SF.Files
For Each file In Fichiers
I = I + 1
Cells(I, J) = file.Path
ActiveWorkbook.ActiveSheet.Hyperlinks.Add _
Anchor:Îlls(I, J), Address:=file.Path
Next file
dany SF
Next SF
End If
End Sub

Merci











Daniel.j
Le #4221381
Pour completer

'MsoFileDialogType peut être l'une de ces constantes MsoFileDialogType.
'msoFileDialogFilePicker. Permet à l'utilisateur de sélectionner un fichier.
'msoFileDialogFolderPicker. Permet à l'utilisateur de sélectionner un
dossier.
'msoFileDialogOpen. Permet à l'utilisateur d'ouvrir un fichier.
'msoFileDialogSaveAs. Permet à l'utilisateur d'enregistrer un fichier.

Daniel

--
FAQ MPFE
FAQ du forum microsoft.public.fr.excel
http://dj.joss.free.fr/faq.htm


"isabelle" a écrit dans le message de news:

re bonjour Gaspareau,

voici un exemple :

http://cjoint.com/?cBrCr5CrJ5

isabelle


Merci Isabelle d'avoir pris le temps de me répondre
mais ça ne semble pas fonctionner.
La fenêtre qui est appelée me permet de choisir un fichier,
pas un répertoire.

Ou je ne fais pas la bonne manipulation..

"isabelle" a écrit dans le message de
news:

bonjour Gaspareau,

With Application.FileDialog(msoFileDialogFolderPicker)
.Show
répertoire = .SelectedItems(1)
End With

isabelle



Bonjour,

J'ai récupéré, sur Excelabo je crois, la macro suivante
qui me crée un fichier avec des liens hypertexte vers les
fichiers inclus dans un répertoire nommé

Cependant je dois aller éditer la macro lorsque je veux la
même chose vers un autre répertoire.

J'ai tenté de trouver depuis hier, sans succès vous l'avez deviné, de
modifier
cette macro afin d'avoir un messagebox qui me demanderait
quel répertoire je veux "hypertexter". Je me tourne donc vers vous...

Autrement dit je veux pouvoir changer via un message box le
F:3 TRAVAUX PUBLICSGeomatiqueBase de Donnees
de mon exemple ci-joint.

Voici le code que j'utilise

Merci d'avance


Rem Attribute VB_Name = "AfficherFichiersHypertexte"

Dim I As Long, J As Integer
'ce code, tel qu'il est rédigé, nécessite que la librairie
'Microsoft Scripting Runtime soit cochée dans OutilRéférences
'pour fonctionner.
'sinon, FileSystemObject, Folder, Files ne sont pas reconus
'et doivent être déclarés As Object

Sub creerlienshypertexte()
'dans l'appel à GetFolder, il faut un antislash final
Dim racine
racine = "F:3 TRAVAUX PUBLICSGeomatiqueBase de Donnees"
Repertoire (racine)
End Sub

Sub Repertoire(rep$)
'ajoute une feuille au classeur actif, appelle la procédure
'récursive à partir du dossier racine de la recherche (rep)
'met en forme la colonne des résultats
Application.ScreenUpdating = False
Sheets.Add
I = 1: J = 1
With New FileSystemObject
dany .GetFolder(rep) 'GetFolder requiert un antislash final
End With
ActiveSheet.UsedRange.EntireColumn.AutoFit
ActiveWindow.Zoom = 80

End Sub

Private Sub dany(ByVal F As Folder)
'd'après L Longre
'boucle sur les dossiers et sous dossiers de F
'écrit les noms et chemins complets des fichiers
'trouvés dans la colonne A d'une feuille de calcul
'crée un lien hypertexte vers chaque fichier
If F.SubFolders.Count Then
Dim SF As Folder
For Each SF In F.SubFolders
Dim Fichiers As Files
Set Fichiers = SF.Files
For Each file In Fichiers
I = I + 1
Cells(I, J) = file.Path
ActiveWorkbook.ActiveSheet.Hyperlinks.Add _
Anchor:Îlls(I, J), Address:=file.Path
Next file
dany SF
Next SF
End If
End Sub

Merci












Gaspareau
Le #4221351
Merci encore

Je suis probablement bouché ou nul ou encore les 2
mais je n'arrive pas à insérer ton code dans ma macro

Avec ton exemple effectivement il trouve le nom du répertoire
mais lorsque je l'ajoute à ma macro....

Désolé


"isabelle" a écrit dans le message de
news:
re bonjour Gaspareau,

voici un exemple :

http://cjoint.com/?cBrCr5CrJ5

isabelle


Merci Isabelle d'avoir pris le temps de me répondre
mais ça ne semble pas fonctionner.
La fenêtre qui est appelée me permet de choisir un fichier,
pas un répertoire.

Ou je ne fais pas la bonne manipulation..

"isabelle" a écrit dans le message de
news:

bonjour Gaspareau,

With Application.FileDialog(msoFileDialogFolderPicker)
.Show
répertoire = .SelectedItems(1)
End With

isabelle



Bonjour,

J'ai récupéré, sur Excelabo je crois, la macro suivante
qui me crée un fichier avec des liens hypertexte vers les
fichiers inclus dans un répertoire nommé

Cependant je dois aller éditer la macro lorsque je veux la
même chose vers un autre répertoire.

J'ai tenté de trouver depuis hier, sans succès vous l'avez deviné, de
modifier
cette macro afin d'avoir un messagebox qui me demanderait
quel répertoire je veux "hypertexter". Je me tourne donc vers vous...

Autrement dit je veux pouvoir changer via un message box le
F:3 TRAVAUX PUBLICSGeomatiqueBase de Donnees
de mon exemple ci-joint.

Voici le code que j'utilise

Merci d'avance


Rem Attribute VB_Name = "AfficherFichiersHypertexte"

Dim I As Long, J As Integer
'ce code, tel qu'il est rédigé, nécessite que la librairie
'Microsoft Scripting Runtime soit cochée dans OutilRéférences
'pour fonctionner.
'sinon, FileSystemObject, Folder, Files ne sont pas reconus
'et doivent être déclarés As Object

Sub creerlienshypertexte()
'dans l'appel à GetFolder, il faut un antislash final
Dim racine
racine = "F:3 TRAVAUX PUBLICSGeomatiqueBase de Donnees"
Repertoire (racine)
End Sub

Sub Repertoire(rep$)
'ajoute une feuille au classeur actif, appelle la procédure
'récursive à partir du dossier racine de la recherche (rep)
'met en forme la colonne des résultats
Application.ScreenUpdating = False
Sheets.Add
I = 1: J = 1
With New FileSystemObject
dany .GetFolder(rep) 'GetFolder requiert un antislash final
End With
ActiveSheet.UsedRange.EntireColumn.AutoFit
ActiveWindow.Zoom = 80

End Sub

Private Sub dany(ByVal F As Folder)
'd'après L Longre
'boucle sur les dossiers et sous dossiers de F
'écrit les noms et chemins complets des fichiers
'trouvés dans la colonne A d'une feuille de calcul
'crée un lien hypertexte vers chaque fichier
If F.SubFolders.Count Then
Dim SF As Folder
For Each SF In F.SubFolders
Dim Fichiers As Files
Set Fichiers = SF.Files
For Each file In Fichiers
I = I + 1
Cells(I, J) = file.Path
ActiveWorkbook.ActiveSheet.Hyperlinks.Add _
Anchor:Îlls(I, J), Address:=file.Path
Next file
dany SF
Next SF
End If
End Sub

Merci













isabelle
Le #4221251
voilà,

Sub creerlienshypertexte()
'dans l'appel à GetFolder, il faut un antislash final
Dim racine
With Application.FileDialog(msoFileDialogFolderPicker).Show
racine = .SelectedItems(1)
End With
Repertoire (racine)
End Sub

isabelle


Merci encore

Je suis probablement bouché ou nul ou encore les 2
mais je n'arrive pas à insérer ton code dans ma macro

Avec ton exemple effectivement il trouve le nom du répertoire
mais lorsque je l'ajoute à ma macro....

Désolé


"isabelle" a écrit dans le message de
news:

re bonjour Gaspareau,

voici un exemple :

http://cjoint.com/?cBrCr5CrJ5

isabelle



Merci Isabelle d'avoir pris le temps de me répondre
mais ça ne semble pas fonctionner.
La fenêtre qui est appelée me permet de choisir un fichier,
pas un répertoire.

Ou je ne fais pas la bonne manipulation..

"isabelle" a écrit dans le message de
news:


bonjour Gaspareau,

With Application.FileDialog(msoFileDialogFolderPicker)
.Show
répertoire = .SelectedItems(1)
End With

isabelle




Bonjour,

J'ai récupéré, sur Excelabo je crois, la macro suivante
qui me crée un fichier avec des liens hypertexte vers les
fichiers inclus dans un répertoire nommé

Cependant je dois aller éditer la macro lorsque je veux la
même chose vers un autre répertoire.

J'ai tenté de trouver depuis hier, sans succès vous l'avez deviné, de
modifier
cette macro afin d'avoir un messagebox qui me demanderait
quel répertoire je veux "hypertexter". Je me tourne donc vers vous...

Autrement dit je veux pouvoir changer via un message box le
F:3 TRAVAUX PUBLICSGeomatiqueBase de Donnees
de mon exemple ci-joint.

Voici le code que j'utilise

Merci d'avance


Rem Attribute VB_Name = "AfficherFichiersHypertexte"

Dim I As Long, J As Integer
'ce code, tel qu'il est rédigé, nécessite que la librairie
'Microsoft Scripting Runtime soit cochée dans OutilRéférences
'pour fonctionner.
'sinon, FileSystemObject, Folder, Files ne sont pas reconus
'et doivent être déclarés As Object

Sub creerlienshypertexte()
'dans l'appel à GetFolder, il faut un antislash final
Dim racine
racine = "F:3 TRAVAUX PUBLICSGeomatiqueBase de Donnees"
Repertoire (racine)
End Sub

Sub Repertoire(rep$)
'ajoute une feuille au classeur actif, appelle la procédure
'récursive à partir du dossier racine de la recherche (rep)
'met en forme la colonne des résultats
Application.ScreenUpdating = False
Sheets.Add
I = 1: J = 1
With New FileSystemObject
dany .GetFolder(rep) 'GetFolder requiert un antislash final
End With
ActiveSheet.UsedRange.EntireColumn.AutoFit
ActiveWindow.Zoom = 80

End Sub

Private Sub dany(ByVal F As Folder)
'd'après L Longre
'boucle sur les dossiers et sous dossiers de F
'écrit les noms et chemins complets des fichiers
'trouvés dans la colonne A d'une feuille de calcul
'crée un lien hypertexte vers chaque fichier
If F.SubFolders.Count Then
Dim SF As Folder
For Each SF In F.SubFolders
Dim Fichiers As Files
Set Fichiers = SF.Files
For Each file In Fichiers
I = I + 1
Cells(I, J) = file.Path
ActiveWorkbook.ActiveSheet.Hyperlinks.Add _
Anchor:Îlls(I, J), Address:=file.Path
Next file
dany SF
Next SF
End If
End Sub

Merci

















Gaspareau
Le #4219561
Salut Isabelle

J'ai ajouté ton code tel que tu me l'as donnée et j'ai un message d'erreur

Voici le résultat

http://cjoint.com/?cBwXhZjHfc

Encore merci

"isabelle" a écrit dans le message de
news:%
voilà,

Sub creerlienshypertexte()
'dans l'appel à GetFolder, il faut un antislash final
Dim racine
With Application.FileDialog(msoFileDialogFolderPicker).Show
racine = .SelectedItems(1)
End With
Repertoire (racine)
End Sub

isabelle


Merci encore

Je suis probablement bouché ou nul ou encore les 2
mais je n'arrive pas à insérer ton code dans ma macro

Avec ton exemple effectivement il trouve le nom du répertoire
mais lorsque je l'ajoute à ma macro....

Désolé


"isabelle" a écrit dans le message de
news:

re bonjour Gaspareau,

voici un exemple :

http://cjoint.com/?cBrCr5CrJ5

isabelle



Merci Isabelle d'avoir pris le temps de me répondre
mais ça ne semble pas fonctionner.
La fenêtre qui est appelée me permet de choisir un fichier,
pas un répertoire.

Ou je ne fais pas la bonne manipulation..

"isabelle" a écrit dans le message de
news:


bonjour Gaspareau,

With Application.FileDialog(msoFileDialogFolderPicker)
.Show
répertoire = .SelectedItems(1)
End With

isabelle




Bonjour,

J'ai récupéré, sur Excelabo je crois, la macro suivante
qui me crée un fichier avec des liens hypertexte vers les
fichiers inclus dans un répertoire nommé

Cependant je dois aller éditer la macro lorsque je veux la
même chose vers un autre répertoire.

J'ai tenté de trouver depuis hier, sans succès vous l'avez deviné, de
modifier
cette macro afin d'avoir un messagebox qui me demanderait
quel répertoire je veux "hypertexter". Je me tourne donc vers
vous...







Autrement dit je veux pouvoir changer via un message box le
F:3 TRAVAUX PUBLICSGeomatiqueBase de Donnees
de mon exemple ci-joint.

Voici le code que j'utilise

Merci d'avance


Rem Attribute VB_Name = "AfficherFichiersHypertexte"

Dim I As Long, J As Integer
'ce code, tel qu'il est rédigé, nécessite que la librairie
'Microsoft Scripting Runtime soit cochée dans OutilRéférences
'pour fonctionner.
'sinon, FileSystemObject, Folder, Files ne sont pas reconus
'et doivent être déclarés As Object

Sub creerlienshypertexte()
'dans l'appel à GetFolder, il faut un antislash final
Dim racine
racine = "F:3 TRAVAUX PUBLICSGeomatiqueBase de Donnees"
Repertoire (racine)
End Sub

Sub Repertoire(rep$)
'ajoute une feuille au classeur actif, appelle la procédure
'récursive à partir du dossier racine de la recherche (rep)
'met en forme la colonne des résultats
Application.ScreenUpdating = False
Sheets.Add
I = 1: J = 1
With New FileSystemObject
dany .GetFolder(rep) 'GetFolder requiert un antislash final
End With
ActiveSheet.UsedRange.EntireColumn.AutoFit
ActiveWindow.Zoom = 80

End Sub

Private Sub dany(ByVal F As Folder)
'd'après L Longre
'boucle sur les dossiers et sous dossiers de F
'écrit les noms et chemins complets des fichiers
'trouvés dans la colonne A d'une feuille de calcul
'crée un lien hypertexte vers chaque fichier
If F.SubFolders.Count Then
Dim SF As Folder
For Each SF In F.SubFolders
Dim Fichiers As Files
Set Fichiers = SF.Files
For Each file In Fichiers
I = I + 1
Cells(I, J) = file.Path
ActiveWorkbook.ActiveSheet.Hyperlinks.Add _
Anchor:Îlls(I, J), Address:=file.Path
Next file
dany SF
Next SF
End If
End Sub

Merci



















isabelle
Le #4219441
oups désolé Gaspareau,
la commande
.show
doit être tout seul sur une ligne,

Sub creerlienshypertexte()
'dans l'appel à GetFolder, il faut un antislash final
Dim racine
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
racine = .SelectedItems(1)
End With
Repertoire (racine)
End Sub

isabelle

Salut Isabelle

J'ai ajouté ton code tel que tu me l'as donnée et j'ai un message d'erreur

Voici le résultat

http://cjoint.com/?cBwXhZjHfc

Encore merci

"isabelle" a écrit dans le message de
news:%

voilà,

Sub creerlienshypertexte()
'dans l'appel à GetFolder, il faut un antislash final
Dim racine
With Application.FileDialog(msoFileDialogFolderPicker).Show
racine = .SelectedItems(1)
End With
Repertoire (racine)
End Sub

isabelle



Merci encore

Je suis probablement bouché ou nul ou encore les 2
mais je n'arrive pas à insérer ton code dans ma macro

Avec ton exemple effectivement il trouve le nom du répertoire
mais lorsque je l'ajoute à ma macro....

Désolé


"isabelle" a écrit dans le message de
news:


re bonjour Gaspareau,

voici un exemple :

http://cjoint.com/?cBrCr5CrJ5

isabelle




Merci Isabelle d'avoir pris le temps de me répondre
mais ça ne semble pas fonctionner.
La fenêtre qui est appelée me permet de choisir un fichier,
pas un répertoire.

Ou je ne fais pas la bonne manipulation..

"isabelle" a écrit dans le message de
news:



bonjour Gaspareau,

With Application.FileDialog(msoFileDialogFolderPicker)
.Show
répertoire = .SelectedItems(1)
End With

isabelle





Bonjour,

J'ai récupéré, sur Excelabo je crois, la macro suivante
qui me crée un fichier avec des liens hypertexte vers les
fichiers inclus dans un répertoire nommé

Cependant je dois aller éditer la macro lorsque je veux la
même chose vers un autre répertoire.

J'ai tenté de trouver depuis hier, sans succès vous l'avez deviné, de
modifier
cette macro afin d'avoir un messagebox qui me demanderait
quel répertoire je veux "hypertexter". Je me tourne donc vers







vous...

Autrement dit je veux pouvoir changer via un message box le
F:3 TRAVAUX PUBLICSGeomatiqueBase de Donnees
de mon exemple ci-joint.

Voici le code que j'utilise

Merci d'avance


Rem Attribute VB_Name = "AfficherFichiersHypertexte"

Dim I As Long, J As Integer
'ce code, tel qu'il est rédigé, nécessite que la librairie
'Microsoft Scripting Runtime soit cochée dans OutilRéférences
'pour fonctionner.
'sinon, FileSystemObject, Folder, Files ne sont pas reconus
'et doivent être déclarés As Object

Sub creerlienshypertexte()
'dans l'appel à GetFolder, il faut un antislash final
Dim racine
racine = "F:3 TRAVAUX PUBLICSGeomatiqueBase de Donnees"
Repertoire (racine)
End Sub

Sub Repertoire(rep$)
'ajoute une feuille au classeur actif, appelle la procédure
'récursive à partir du dossier racine de la recherche (rep)
'met en forme la colonne des résultats
Application.ScreenUpdating = False
Sheets.Add
I = 1: J = 1
With New FileSystemObject
dany .GetFolder(rep) 'GetFolder requiert un antislash final
End With
ActiveSheet.UsedRange.EntireColumn.AutoFit
ActiveWindow.Zoom = 80

End Sub

Private Sub dany(ByVal F As Folder)
'd'après L Longre
'boucle sur les dossiers et sous dossiers de F
'écrit les noms et chemins complets des fichiers
'trouvés dans la colonne A d'une feuille de calcul
'crée un lien hypertexte vers chaque fichier
If F.SubFolders.Count Then
Dim SF As Folder
For Each SF In F.SubFolders
Dim Fichiers As Files
Set Fichiers = SF.Files
For Each file In Fichiers
I = I + 1
Cells(I, J) = file.Path
ActiveWorkbook.ActiveSheet.Hyperlinks.Add _
Anchor:Îlls(I, J), Address:=file.Path
Next file
dany SF
Next SF
End If
End Sub

Merci






















Gaspareau
Le #4360931
Merci beaucoup

maintenant ca fonctionne super


"isabelle" a écrit dans le message de
news:%
oups désolé Gaspareau,
la commande
.show
doit être tout seul sur une ligne,

Sub creerlienshypertexte()
'dans l'appel à GetFolder, il faut un antislash final
Dim racine
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
racine = .SelectedItems(1)
End With
Repertoire (racine)
End Sub

isabelle

Salut Isabelle

J'ai ajouté ton code tel que tu me l'as donnée et j'ai un message
d'erreur



Voici le résultat

http://cjoint.com/?cBwXhZjHfc

Encore merci

"isabelle" a écrit dans le message de
news:%

voilà,

Sub creerlienshypertexte()
'dans l'appel à GetFolder, il faut un antislash final
Dim racine
With Application.FileDialog(msoFileDialogFolderPicker).Show
racine = .SelectedItems(1)
End With
Repertoire (racine)
End Sub

isabelle



Merci encore

Je suis probablement bouché ou nul ou encore les 2
mais je n'arrive pas à insérer ton code dans ma macro

Avec ton exemple effectivement il trouve le nom du répertoire
mais lorsque je l'ajoute à ma macro....

Désolé


"isabelle" a écrit dans le message de
news:


re bonjour Gaspareau,

voici un exemple :

http://cjoint.com/?cBrCr5CrJ5

isabelle




Merci Isabelle d'avoir pris le temps de me répondre
mais ça ne semble pas fonctionner.
La fenêtre qui est appelée me permet de choisir un fichier,
pas un répertoire.

Ou je ne fais pas la bonne manipulation..

"isabelle" a écrit dans le message de
news:



bonjour Gaspareau,

With Application.FileDialog(msoFileDialogFolderPicker)
.Show
répertoire = .SelectedItems(1)
End With

isabelle





Bonjour,

J'ai récupéré, sur Excelabo je crois, la macro suivante
qui me crée un fichier avec des liens hypertexte vers les
fichiers inclus dans un répertoire nommé

Cependant je dois aller éditer la macro lorsque je veux la
même chose vers un autre répertoire.

J'ai tenté de trouver depuis hier, sans succès vous l'avez deviné,
de








modifier
cette macro afin d'avoir un messagebox qui me demanderait
quel répertoire je veux "hypertexter". Je me tourne donc vers







vous...

Autrement dit je veux pouvoir changer via un message box le
F:3 TRAVAUX PUBLICSGeomatiqueBase de Donnees
de mon exemple ci-joint.

Voici le code que j'utilise

Merci d'avance


Rem Attribute VB_Name = "AfficherFichiersHypertexte"

Dim I As Long, J As Integer
'ce code, tel qu'il est rédigé, nécessite que la librairie
'Microsoft Scripting Runtime soit cochée dans OutilRéférences
'pour fonctionner.
'sinon, FileSystemObject, Folder, Files ne sont pas reconus
'et doivent être déclarés As Object

Sub creerlienshypertexte()
'dans l'appel à GetFolder, il faut un antislash final
Dim racine
racine = "F:3 TRAVAUX PUBLICSGeomatiqueBase de Donnees"
Repertoire (racine)
End Sub

Sub Repertoire(rep$)
'ajoute une feuille au classeur actif, appelle la procédure
'récursive à partir du dossier racine de la recherche (rep)
'met en forme la colonne des résultats
Application.ScreenUpdating = False
Sheets.Add
I = 1: J = 1
With New FileSystemObject
dany .GetFolder(rep) 'GetFolder requiert un antislash final
End With
ActiveSheet.UsedRange.EntireColumn.AutoFit
ActiveWindow.Zoom = 80

End Sub

Private Sub dany(ByVal F As Folder)
'd'après L Longre
'boucle sur les dossiers et sous dossiers de F
'écrit les noms et chemins complets des fichiers
'trouvés dans la colonne A d'une feuille de calcul
'crée un lien hypertexte vers chaque fichier
If F.SubFolders.Count Then
Dim SF As Folder
For Each SF In F.SubFolders
Dim Fichiers As Files
Set Fichiers = SF.Files
For Each file In Fichiers
I = I + 1
Cells(I, J) = file.Path
ActiveWorkbook.ActiveSheet.Hyperlinks.Add _
Anchor:Îlls(I, J), Address:=file.Path
Next file
dany SF
Next SF
End If
End Sub

Merci
























Publicité
Poster une réponse
Anonyme