Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Modif de code

Modif de code

2 réponses
Avatar
Franck
Bonjour,

Quelqu'un serait t-il modifier ce code de fa=E7on =E0 avoir=20
un lien hypertexte pointant vers ces r=E9pertoires=20
automatiquement

=20
Sub TousLesDossiers(LeDossier$, Idx As Long)
Dim fso As Object, Dossier As Object
Dim sousRep As Object, Flder As Object

Set fso =3D CreateObject("Scripting.FileSystemObject")
Set Dossier =3D fso.GetFolder(LeDossier)
=20
'examen du dossier courant
For Each Flder In Dossier.subfolders
Idx =3D Idx + 1
Cells(Idx, 1).Value =3D Flder.Path
Next
=20
'traitement r=E9cursif des sous dossiers
For Each sousRep In Dossier.subfolders
TousLesDossiers sousRep.Path, Idx
Next sousRep
=20
Set fso =3D Nothing
=20
End Sub 'fs

Sub test()
TousLesDossiers "d:\clients", 0
End Sub


Merci d'avance
Signaler un problème avec ce contenu

2 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Alain CROS
Bonjour.

Remplace ta boucle 'examen du dossier courant par :

For Each Flder In Dossier.subfolders
Idx = Idx + 1
Cells(Idx, 1).Value = Flder.Path
ActiveSheet.Hyperlinks.Add Anchor:Îlls(Idx, 1), Address:= _
Cells(Idx, 1).Value
Next

Alain CROS.

"Franck" a écrit dans le message de news: 604c01c3e5a6$53c9ece0$
Bonjour,

Quelqu'un serait t-il modifier ce code de façon à avoir
un lien hypertexte pointant vers ces répertoires
automatiquement


Sub TousLesDossiers(LeDossier$, Idx As Long)
Dim fso As Object, Dossier As Object
Dim sousRep As Object, Flder As Object

Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.GetFolder(LeDossier)

'examen du dossier courant
For Each Flder In Dossier.subfolders
Idx = Idx + 1
Cells(Idx, 1).Value = Flder.Path
Next

'traitement récursif des sous dossiers
For Each sousRep In Dossier.subfolders
TousLesDossiers sousRep.Path, Idx
Next sousRep

Set fso = Nothing

End Sub 'fs

Sub test()
TousLesDossiers "d:clients", 0
End Sub


Merci d'avance
Avatar
Franck
Meilleurs Voeux



-----Message d'origine-----
Bonjour.

Remplace ta boucle 'examen du dossier courant par :

For Each Flder In Dossier.subfolders
Idx = Idx + 1
Cells(Idx, 1).Value = Flder.Path
ActiveSheet.Hyperlinks.Add Anchor:Îlls(Idx, 1),
Address:= _

Cells(Idx, 1).Value
Next

Alain CROS.

"Franck" a écrit
dans le message de news: 604c01c3e5a6$53c9ece0

$
Bonjour,

Quelqu'un serait t-il modifier ce code de façon à avoir
un lien hypertexte pointant vers ces répertoires
automatiquement


Sub TousLesDossiers(LeDossier$, Idx As Long)
Dim fso As Object, Dossier As Object
Dim sousRep As Object, Flder As Object

Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.GetFolder(LeDossier)

'examen du dossier courant
For Each Flder In Dossier.subfolders
Idx = Idx + 1
Cells(Idx, 1).Value = Flder.Path
Next

'traitement récursif des sous dossiers
For Each sousRep In Dossier.subfolders
TousLesDossiers sousRep.Path, Idx
Next sousRep

Set fso = Nothing

End Sub 'fs

Sub test()
TousLesDossiers "d:clients", 0
End Sub


Merci d'avance


.