Chemin abrégé d'un fichier comme dans word et excel qd la taille est trop longue

Soyez le premier à donner votre avis sur cette source.

Vue 4 960 fois - Téléchargée 176 fois

Description

Ex: "c:\programfiles\documents\monfichier.txt" devient "c:\programfiles\...\monfichier.txt"

La fonction "ShortDisplayPath" va abréger le chemin du fichier jusqua ce que ce chemin ne fasse pas plus de "MaxLenght" caracteres (50 par défaut)... Il laisse intact si c'est assez court.

C'est trés pratique pour les popmenu et liste déroulante avec une liste de chemins qui sont pas trés pratique quand la fin est cachée (trop longue) et/ou que le controle prend (automatiquement) une largeur en plein écran pour s'adapter :o((

Source / Exemple :


'Short Display path like recents files popupmenu in Word or Excel
Public Function ShortDisplayPath(ByVal FullPath As String, Optional ByVal MaxLenght As Integer = 50) As String
    Dim FileName, RootPath As String
    
    If Len(FullPath) > MaxLenght Then
        FileName = NomDossierSansChemin(FullPath)
        RootPath = Left(FullPath, Len(FullPath) - Len(FileName) - 1)
        
        Do While ((Len(RootPath) + Len(FileName) + 5) > MaxLenght)
            RootPath = Left(RootPath, InStrRev(RootPath, "\") - 1)
        Loop
        ShortDisplayPath = RootPath & "\...\" & FileName
    Else
        ShortDisplayPath = FullPath
    End If
End Function

Conclusion :


Créé pour le projet "Yahoo! Messenger Plus" :
http://www.yahooplus.fr.st

Les commentaires en anglais (sorry), c'est parceque ya surtout des benevoles anglais pour le projet... .oO(fô rien demander à des francais si ya po de fric à gagner :o| )

Codes Sources

A voir également

Ajouter un commentaire Commentaires
cs_intertek Messages postés 9 Date d'inscription mardi 1 avril 2003 Statut Membre Dernière intervention 8 octobre 2004
8 oct. 2004 à 13:23
Ok je vois bien vu :)
cs_olid Messages postés 296 Date d'inscription lundi 2 septembre 2002 Statut Membre Dernière intervention 28 janvier 2008
8 oct. 2004 à 12:45
Okidoki....le pb, cest le nom de ton fichier ; il fait plus de 100 caracteres ! :o(

il faudrait ajouter un test avant la boucle pour gérer ce cas là. Et pour renvoyer une chaine sous cette forme :

"c:\...\x86_Microsoft.Tools.VisualCPlusPlus.Runtim..."

le nom du fichier doit etre raccourci de (maxlenght - 10) caracteres en partant de la gauche... Si tu veux suivre l'exemple de Office ;op

Jai pô le temps de le corriger et mettre à jour... Pense à nous si tu le fais ;o)
cs_intertek Messages postés 9 Date d'inscription mardi 1 avril 2003 Statut Membre Dernière intervention 8 octobre 2004
8 oct. 2004 à 09:03
bé en fait j'ai fait une recherche sur tout mon C:\ des fichiers *.txt et systématiquement j'en ai un qui plante :

En debug sous vb j'obtiens les valeurs suivantes lors de l'erreur

? MaxLenght
100
? FullPath
C:\WINDOWS\WinSxS\x86_Microsoft.Tools.VisualCPlusPlus.Runtime-Libraries.Resources_6595b64144ccf1df_6.0.0.0_fr-FR_9d8c4a39
? RootPath
C:
? FileName
x86_Microsoft.Tools.VisualCPlusPlus.Runtime-Libraries.Resources_6595b64144ccf1df_6.0.0.0_fr-FR_9d8c4a39

Et donc le InStrRev(RootPath, "") avec le C: et bien ça renvoit 0, je suis désolé de reproduire ce bug :( quand au exit do si on le fait pas la boucle est infini.

Voila pour les petits détails que je peux t'apporter.

++
cs_olid Messages postés 296 Date d'inscription lundi 2 septembre 2002 Statut Membre Dernière intervention 28 janvier 2008
7 oct. 2004 à 19:26
Heu.. je comprend pô comment tu peux avoir un InStrRev(RootPath, "") égal à 0... Car ya toujour au moins les deux "\" du lecteur disque !!! :o.

Ou alors, tas donné un chemin relatif avec des "..", non ?

Etpis, faire un "exit do", çà te donne un resultat cohérent ?
cs_intertek Messages postés 9 Date d'inscription mardi 1 avril 2003 Statut Membre Dernière intervention 8 octobre 2004
7 oct. 2004 à 10:30
J'ai eu un bug en l'utilisant
J'ai eu un InStrRev(RootPath, "") égal à 0
J'ai corrigé de cette façon :
Do While ((Len(RootPath) + Len(FileName) + 5) > MaxLenght)
If InStrRev(RootPath, "") > 0 Then
RootPath = Left(RootPath, InStrRev(RootPath, "") - 1)
Else
Exit Do
End If
Loop

Sinon ça marche bien :)

++

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.