XL 2010 Chargement Bdd en lien hypertexte depuis usb

BUG à dit:

Bonjour à tous,

Je sollicite si possible votre aide pour un néophyte catastrophique…
J’ai trouvé un code sur le site qui correspondrait presque à ma quête,
Sauf qu’évidement je n’arrive pas me l adapté.
A l’ouverture du classeur, le code doit charger dans une feuille les titres
Des fichiers en lien Hypertexte situés dans une clé USB
G :\BASE DE DONNEES.
Ça marche seulement si le classeur se trouve dans le même fichier, surement
du répertoire = ThisWorkbook.Path & "\"

Tout aide me sera bien précieuse, merci


Private Sub Workbook_Open()
Application.ScreenUpdating = False
Range("A2:A65000").ClearContents
repertoire = ThisWorkbook.Path & "G\BASE DE DONNEES"
[H4] = repertoire
ligne = 4
nf = Dir(repertoire & "*.*") 'on peut faire aussi premier fichier xls, pdf CA C EST COOL
Do While nf <> ""
ActiveSheet.Hyperlinks.Add Anchor:=Cells(ligne, 1), Address:=repertoire & "\" & nf, TextToDisplay:=nf
ligne = ligne + 1
nf = Dir ' fichier suivant
Loop
Range("a2:A" & [A65000].End(xlUp).Row).Sort key1:=[A2]

End Sub

Cliquez pour agrandir...

Bonjour,

Essaye avec
repertoire = "G:\BASE DE DONNEES\"

La lettre du lecteur usb doit être "G"
Le dossier "BASE DE DONNEES" doit exister

Merci pour ta réponse Jacky,

j ai bien essayé et le dossier existe bien.
merci

BUG à dit:

Merci pour ta réponse Jacky,

j ai bien essayé et le dossier existe bien.
merci

Cliquez pour agrandir...

Re…
Et alors ??
Un peu vague comme réponse.
Le test avec
repertoire = "G:\BASE DE DONNEES\"
Ca donne quoi ???

**Pour le code complet, je ferais comme ceci
A placer dans le ThisWorkbook

Bonjour Jacky,

en effet, j'ai été plutôt vague , je m 'en excuse.
Je viens de copier ton code, j 'ai remis un autre Disque dur ou cas ou (sur le port G ) et la super
cela fonctionne .

Un grand merci à toi d 'avoir pris le temps de voir mon problème.

Bonjour Jacky , le Forum,

je reviens vers vous si possible pour "nettoyer" le code que j 'ai voulu adapté et le modifier.et la je tourne en rond !!
( en fait j ai recopié bêtement le code 3 fois en changement le type de fichier chargé et leur emplacement )
je voudrai avoir en 2 eme ligne des titres spécifiant le chargement ( ex : en A2 "tous les fichiers" , en B2 " fichiers PDF"....
Merci pour votre indulgence 🙁


Private Sub Workbook_Open()
'chargement de tous les fichiers avec hyperliens en colonne A
Dim Repertoire As String, Nf As String, Ligne&
Application.ScreenUpdating = False
Repertoire = "G:\BASE DE DONNEES\"
With Feuil1
.Cells.Clear
'ENDROIT OU SERA ECRIT LE CHEMIN DU repertoire
With .[A1]
.Value = Repertoire: .Font.Bold = True: .Font.Size = 14: .HorizontalAlignment = xlCenter
'essai color font de cellule
Range("A1:C1").Interior.Color = RGB(0, 160, 128)
'Epaisseur de la bordure
'Selection.Borders.Weight = 4
'Couleur de la bordure : rouge
'Selection.Borders.Color = RGB(0, 0, 0)
.BorderAround LineStyle:=xlDouble
.Borders(xlInsideHorizontal).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlContinuous
End With
'ligne ou debutera la liste
Ligne = 10
Nf = Dir(Repertoire & "*.*") ''type de fichier a rechercher ex premier fichier xls,ou pdf ....
Do While Nf <> ""
' colonne ou la liste sera ligne 1 =colonne A
.Hyperlinks.Add Anchor:=.Cells(Ligne, 1), Address:=Repertoire & "\" & Nf, TextToDisplay:=Nf
Ligne = Ligne + 1
Nf = Dir ' fichier suivant
Loop
.Range("a2:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Sort key1:=.[A2]
.Columns(1).AutoFit
End With
'Application.ScreenUpdating = True


'chargement de tous les fichiers PDF avec hyperliens en colonne B
With Feuil1
' Nettoyage de feuille
' .Cells.Clear
'ENDROIT OU SERA ECRIT LE CHEMIN DU repertoire
With .[B1]
'police , taille du nom du repertoire
.Value = Repertoire: .Font.Bold = True: .Font.Size = 14: .HorizontalAlignment = xlCenter
.BorderAround LineStyle:=xlDouble
.Borders(xlInsideHorizontal).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlContinuous
End With
'ligne ou debutera la liste
Ligne = 15
Nf = Dir(Repertoire & "*.pdf") 'type de fichier a rechercher ex premier fichier xls,ou pdf ....
Do While Nf <> "" ' repeter la boucle de recherche au 2 eme, 3 eme ...
' colonne ou la liste sera ligne 1 =colonne A
.Hyperlinks.Add Anchor:=.Cells(Ligne, 2), Address:=Repertoire & "\" & Nf, TextToDisplay:=Nf
Ligne = Ligne + 1
Nf = Dir ' fichier suivant
Loop
.Range("b2:B" & .Cells(Rows.Count, "B").End(xlUp).Row).Sort key1:=.[B2]
.Columns(1).AutoFit
End With
Application.ScreenUpdating = True


' chargement de tous les fichiers AVI avec hyperliens en colonne C

With Feuil1
' Nettoyage de feuille
' .Cells.Clear
'ENDROIT OU SERA ECRIT LE CHEMIN DU repertoire

With .[C1]
.Value = Repertoire: .Font.Bold = True: .Font.Size = 14: .HorizontalAlignment = xlCenter
.BorderAround LineStyle:=xlDouble
.Borders(xlInsideHorizontal).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlContinuous
End With
Ligne = 20
Nf = Dir(Repertoire & "*.avi")
Do While Nf <> ""
' colonne ou la liste sera ligne 1 =colonne A
.Hyperlinks.Add Anchor:=.Cells(Ligne, 3), Address:=Repertoire & "\" & Nf, TextToDisplay:=Nf
Ligne = Ligne + 1
Nf = Dir ' fichier suivant
Loop
.Range("C2:C" & .Cells(Rows.Count, "C").End(xlUp).Row).Sort key1:=.[C2]
.Columns(1).AutoFit
End With
Application.ScreenUpdating = True


End Sub

merci. ( à noté que j 'ai vainement cherché la il est 02h20...)

Re..
Essaye comme ceci

Bonjour Jacky , le Forum,

Impeccable !!
merci beaucoup !!
je passe a la prochaine à la prochaine étape , mettre tout ça dans une listview .
super tu me permets de bien avancer sur mon projet.