XL 2016 Hyperlien

[michelf]

Bonjour à tous,
je viens d'acheter un nouveau PC sur lequel j'ai transféré ma bibliothèque de musiques. J'ai plus de 2000 références et je me vois mal recommencer le lien de chaque ligne avec la musique correspondante (ce que j'avais fait au fure et à mesure sur le pc précédent).
J'ai généré cette liste avec une macro qui reprend l'adresse de chaque morceau; ex :
I:\Ma bibio de musiques\2004-Compile\01 Petite fleur- Sidney Bechet.mp3
I:\Ma bibio de musiques\2004-Compile\03 Satisfaction - Rollig Stones.mp3
etc...
Y aurait-il moyen d'utiliser ces adresses pour automatiser la création d'un hyperlien pour chacun évidemment.
Je vous remercie d'avance pour votre attention. Bonne journée

 

[Lone-wolf]

Bonsoir Michel , le Forum

Voici une macro qui liste tous les fichiers. Si j'ai bien compris ce que tu veux faire.

Sub List_MP3()
Dim Liste(1000, 1), Nom As String, Repertoire As String, Nb As Long

    Application.ScreenUpdating = False

    Range("a2:a2002").ClearContents

    Repertoire = ThisWorkbook.Path & "\Chansons\"
    Nom = Dir$(Repertoire & "*.wav")

    Do While Nom <> ""
        Liste(Nb, 0) = Nom
        Nom = Dir$
        Nb = Nb + 1
    Loop
    Nb = 0

    While Liste(Nb, 0) <> tom
        Range("a2").Offset(Nb, 0).Value = Replace(Liste(Nb, 0), ".wav", "")
        Nb = Nb + 1
        Range("a:a").Columns.AutoFit
    Wend
End Sub

 

[michelf]

Merci de m'avoir répondu, mais je pense peut-être m'être mal exprimé : faire la liste de répertoires, ça je l'ai fait et la réponse à ma macro est de ce type pour tous les fichiers répertoriés :

I:\Ma bibio de musiques\2004-Compile\01 Petite fleur- Sidney Bechet.mp3
I:\Ma bibio de musiques\2004-Compile\02 Fellicidade - Cibelle.mp3
I:\Ma bibio de musiques\2004-Compile\03 Satisfaction - Rollig Stones.mp3
I:\etc...

Ce que je cherchais à faire c'est de créer pour chaque entrée (ça peut être dans la cellule voisine) un hyperlien qui me permettrait d'écouter ces chansons en cliquant sur le lien, Pour le moment si je le fait "à la main" ça donne : aller sur la cellule, cliquer droit : créer lien, rechercher l'emplacement dans mon répertoire musique et valider et ça pour chacune des +/- 2000 lignes ce qui est fastidieux alors que j'ai sous la main le chemin I:\etc...ci-dessus.
Une sorte d'ajout automatique dans "Adresse" de la fenêtre hyperlien, je ne sais pas si je suis assez clair mais en tout cas merci encore pour votre réponse et si jamais vous trouviez une solution je reste preneur évidemment
Bonne journée

 

[michelf]

Re bonjour, je reviens encore vers vous car j'ai fait un essai que voici :

Sub lienhyper()
'
' lienhyper Macro
'
'
Range("A1").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
"I:\Ma bibio de musiques\2004-Compile\02 Fellicidade - Cibelle.mp3", _
TextToDisplay:= _
"I:\Ma bibio de musiques\2004-Compile\02 Fellicidade - Cibelle.mp3"
End Sub

Ce qui marche pour la première cellule mais je ne suis pas assez "fort" pour que ça se passe successivement sur chacune des cellules de ma liste (j'ai un peu oublié le système de boucle); vous peut-être si ce n'est pas abuser...
Merci

 

[MJ13]

Bonjour Michel, Lone

Tu peux tester ce genre de macro en sélectionnant les cellules contenant le lien.

Sub Lien_Hypertext()
For Each Cell In Selection
Cell.select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        Cell.Value, TextToDisplay _
        :=Cell.Value
Next
End Sub

 

[michelf]

MJ13 merci pour votre suivi et désolé de vous remercier si tard (problème d'intendance!)
J'ai testé votre macro qui marche super bien. Si je peux abuser, y a-t-il moyen de faire une routine pour qu'elle s'applique à toutes les cellules-sources jusqu'à ce qu'elle trouve une cellule vide par exemple? Ce serait vraiment l'idéal. Sinon ce n'est pas grave vous m'avez bien aidé.
Bon W-E

 

[Staple1600]

Bonjour le fil, le forum

@michelf
Il y a pléthore d'exemples de macros faisant ce type de job dans les archives du forum
Pour y accéder il suffit de cliquer en haut à droite sur la loupe

Un exemple (datant de 2008) non pris au hasard
https://www.excel-downloads.com/thr...ers-dun-repertoire-windows-vers-excel.107839/

 

[MJ13]

Bonjour à tous

Si je peux abuser, y a-t-il moyen de faire une routine pour qu'elle s'applique à toutes les cellules-sources jusqu'à ce qu'elle trouve une cellule vide par exemple? Ce serait vraiment l'idéal. Sinon ce n'est pas grave vous m'avez bien aidé.
Bon W-E

Comme je ne sais pas comment sont organisées tes données, cela me paraît difficile de t'aider plus. sinon, si tu connais la colonne contenant tes données, il suffit de trouver la dernière ligne avec une macro de ce type pour la colonne 3 :

Derl=cells(rows.count, 3).end(xlup).row

puis avant dans la macro: For Each Cell In Selection

tu rajoutes les données à sélectionner avec ce code:

Range(cells(2,3),cells(derl,3).select

Ce qui donnerait:

Sub Lien_Hypertext()
Derl=cells(rows.count, 3).end(xlup).row
Range(cells(2,3),cells(derl,3).select
For Each Cell In Selection
Cell.select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        Cell.Value, TextToDisplay _
        :=Cell.Value
Next
End Sub

 

[michelf]

Merci encore pour votre aide, mais, voilà, je n'arrive pas à faire tourner votre macro. Ai-je commis une erreur dans la transposition à mon cas?? Je vous mets une capture d'écran de ce que j'ai fait et du fichier auquel je l'ai appliqué. Si je sélectionne manuellement chaque cellule ça marche, mais si je veux appliquer la routine voilà le message ...
J'espère que je ne vous ennuie pas avec ce petit projet...
Bonne journée

 

[MJ13]

Re

Désolé, je l'avais écrit à la main, j'avais oublié une apostrophe ici avant .select:

Range(cells(2,1),cells(derl,1)).select

Sinon, si tu ne veux pas voir le nom du dossier, tu peux tester ceci:

Sub Lien_Hypertext_V2()
derl = Cells(Rows.Count, 1).End(xlUp).Row
Range(Cells(2, 1), Cells(derl, 1)).Select
For Each Cell In Selection
Cell.Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        Cell.Value, TextToDisplay _
        :=Split(Cell, "\")(UBound(Split(Cell, "\"))) 'Cell.Value
Next
End Sub

 

[michelf]

Merciii c'est vraiment génial, si vous avez le temps et pour ma "formation" personnelle comment cette commande fonctionne-t-elle, je ne vois pas de référence de la place des caractères que vous effacez dans :=Split(Cell, "\")(UBound(Split(Cell, "\"))) 'Cell.Value
Je suppose que ça veut dire d'effacer dans la cellule depuis "\" jusque "\" c'est ça? ?
Et si je veux "recopier" le résultat sur une autre feuill est-ce possible?
Après je ne vous ennuierai plus et vous avez déjà toute ma gratitude évidemment

 

[MJ13]

Re

En fait Split permet de casser une chaîne de caractères sur un caractère donné, ici \ et Ubound permet de connaître la plus grande valeur du tableau qui est ici la position du dernier sous-répertoire. Pour avoir l'avant dernier sous-répertoire ou pourra ajouter -1 avec Ubound.

Ce qui pourrait donner dans ton cas:

Sub Lien_Hypertext_V3()
derl = Cells(Rows.Count, 1).End(xlUp).Row
Range(Cells(2, 1), Cells(derl, 1)).Select
For Each cell In Selection
cell.Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
cell.Value, TextToDisplay _
:=Split(cell, "\")(UBound(Split(cell, "\")) - 1) & " " & Split(cell, "\")(UBound(Split(cell, "\"))) 'Cell.Value
cell.Offset(0, 1).Value = cell.Hyperlinks.Item(1).Address
Next
End Sub