affichage partie d'un lien hypertexte

[francedemo]

bonjour à tous,
j'utilise un code pour créer un fichier récap qui récupère la liste des fichiers d'un répertoire.
la macro renseigne automatiquement un certain nb d'info dont le nom du fichier en lien hypertexte
le pb est que le lien hypertexte apparait en taille 7.5 (ça je le corrige dans la macro) mais surtout, j'ai le chemin complet qui s'affiche donc la taille de cellule est très importante et en plus, l'utilisateur n'a pas besoin de lire tout le chemin du fichier correspondant, je voudrai que seul le nom du fichier s'affiche (sans le .xls, qui ne sert pas non plus, si possible)

ci dessous le code utilisé:

Sub ListeFichiersContenu()

Dim Fichier As String
Dim Chemin As String
Dim Derligne As Long

debut = Timer

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks("ListeDevis.xls").Activate
'Nettoyer la zone et sélectionner la cellule de début
    Range("A2:G10000").Clear
    Range("A2").Activate
'Saisir le chemin complet du dossier où se trouvent les fichiers
    Chemin = "O:\xxx\xxxxx\" '(chemin modifié)
'Premier fichier
    Fichier = Dir(Chemin & "*.xls")
    Do While Fichier <> ""
        Application.DisplayAlerts = False
        Workbooks.Open Filename:=Chemin & Fichier
'Inserer lien hypertexte + Copie de "Livraison"
        Windows(Fichier).Activate
        Range("G6").Copy
        Workbooks("ListeDevis.xls").Activate
        Sheets("Base").Select
        Derligne = Range("E65000").End(xlUp).Row + 1
        ActiveWorkbook.ActiveSheet.Hyperlinks.Add _
                Anchor:=Cells(Derligne, 1), Address:=Chemin & Fichier
        Range("B" & Derligne).PasteSpecial _
                    Paste:=xlPasteValuesAndNumberFormats, _
                    Operation:=xlNone, _
                    SkipBlanks:=False, _
                    Transpose:=False
'Copie de "Facturation"
        Windows(Fichier).Activate
        Range("Q6").Copy
        Workbooks("ListeDevis.xls").Activate
        Sheets("Base").Select
        Range("C" & Derligne).PasteSpecial _
                    Paste:=xlPasteValuesAndNumberFormats, _
                    Operation:=xlNone, _
                    SkipBlanks:=False, _
                    Transpose:=False
'Copie de "matériel"
        Windows(Fichier).Activate
        Range("H3").Copy
        Workbooks("ListeDevis.xls").Activate
        Sheets("Base").Select
        Range("D" & Derligne).PasteSpecial _
                    Paste:=xlPasteValues, _
                    Operation:=xlNone, _
                    SkipBlanks:=False, _
                    Transpose:=False
'Copie de "Désignation"
        Windows(Fichier).Activate
        Range("B13:B20").Copy
        Workbooks("ListeDevis.xls").Activate
        Sheets("Base").Select
        Range("E" & Derligne).PasteSpecial _
                    Paste:=xlPasteValues, _
                    Operation:=xlNone, _
                    SkipBlanks:=False, _
                    Transpose:=False
'Insérer une ligne après chaque fichier
        Derligne = Range("E65000").End(xlUp).Row
        Range("A" & Derligne, "E" & Derligne).Select
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlMedium
                .ColorIndex = 6
            End With
'Fermeture du fichier Devis ouvert
        Windows(Fichier).Activate
        Application.CutCopyMode = False
        ActiveWorkbook.Close savechanges:=False
'Fichier suivant
        Fichier = Dir
    Loop
'Fin de la boucle
Workbooks("ListeDevis.xls").Activate
'Nettoyage des lignes vides
Sheets("Base").Select
    For n = Derligne + 10 To 2 Step -1
        If Range("E" & n) = "" Then Rows(n).Delete
    Next n
'Mise en forme des colonnes
Range("B2", "E" & Derligne + 1).EntireColumn.AutoFit

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Range("A2").Activate

    MsgBox ("Terminé en " & Timer - debut & " seconde(s)")

End Sub

 

[francedemo]

Re : affichage partie d'un lien hypertexte

ça n'inspire personne ?

j'ai regardé sur le forum mais je n'ai pas trouvé pour la mise en forme de l'affichage d'un lien hypertext

dans le format, je voudrais supprimer les 34 premiers caractères + les 4 derniers (uniquement pour l'affichage, il faut que le lien reste actif)

à +

 

[Excel-lent]

Re : affichage partie d'un lien hypertexte

Bonjour FranceDemo,

j'ai le chemin complet qui s'affiche donc la taille de cellule est très importante et en plus, l'utilisateur n'a pas besoin de lire tout le chemin du fichier correspondant, je voudrai que seul le nom du fichier s'affiche

    Range("B6").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        "[COLOR="Blue"][B]C:\Mes Documents\Archive\Nom du fichier.xls[/B][/COLOR]", TextToDisplay:= _
        "[COLOR="Red"][I]Nom du fichier[/I][/COLOR]"

C:\Mes Documents\Archive\Nom du fichier.xls : à remplacer par le chemin précis où se trouve ton fichier + le nom du fichier

Nom du fichier : mettre à la place le nom que tu veux montrer à l'utilisateur

je voudrais supprimer les 34 premiers caractères + les 4 derniers (uniquement pour l'affichage, il faut que le lien reste actif)

Dans ce cas il te suffit de mettre dans une variable :
C:\Mes Documents\Archive\Nom du fichier.xls

Puis à l'aide des fonctions DROITE et GAUCHE ("left" et "right" en language VBA), enlever le début et la fin que tu ne veux pas et mettre cela à la place de : Nom du fichier

Et le tour est joué!

Cordialement

 

[francedemo]

Re : affichage partie d'un lien hypertexte

merci Excel-lent

je n'avais pas les éléments pour faire ça en VBA

j'ai mis :

        NomFichier = Left(Fichier, Len(Fichier) - 5)
        ActiveWorkbook.ActiveSheet.Hyperlinks.Add _
                Anchor:=Cells(Derligne, 1), Address:=Chemin & Fichier, _
                TextToDisplay:=NomFichier

comme ça, c'est bon

merci encore

ps : j'ai mis "-5" car tous mes fichiers finissent par "_" (pour un ajout ultérieur), donc je l'enlève sur l'affichage (sinon, j'aurai mis "-4", pour .xls)