0/5 (1 avis)
Snippet vu 5 897 fois - Téléchargée 23 fois
' ' ' Permet de réduire une URL ' par Tioneb pour VBFrance.com ' ' '------code à placer dans un module ou directement dans une form Public Function RaccourcirPath(Path As String, NbrDossiers As Integer, Optional Delimiteur As String = "\", Optional RemplacerPar As String = "[...]", Optional DelimiteurDeFin As Boolean = False) As String Dim Tmp() As String, i As Integer, PathRaccourci As String, PathSaved As String If NbrDossiers <= 0 Or Len(Path) <= 3 Then 'si on rentre une valeur qui n'a pas de sens, et bien on renvoi simplement le chemin complet RaccourcirPath = Path Exit Function End If If Right(Path, 1) = Delimiteur Then 'si le dernier caractère est le délimiteur, on le supprime Path = Left(Path, Len(Path) - 1) End If PathSaved = Path 'on sauvegarde le chemin au cas où on ne passerait pas la prochaine condition Path = Replace(Path, Delimiteur & Delimiteur, Delimiteur, , , vbTextCompare) 'on supprime les doubles délimiteur Tmp() = Split(Path, Delimiteur, , vbTextCompare) 'on crée un tableau avec le chemin entré If UBound(Tmp()) + 1 <= NbrDossiers Or UBound(Tmp()) = 1 Then 'si le chemin à traiter contient moins de dossiers que la limite, on renvoi le chemin (sauvegardé) entier RaccourcirPath = PathSaved Exit Function End If PathRaccourci = Tmp(0) & Delimiteur 'on place la lettre du lecteur dans la variable de sortie For i = 1 To NbrDossiers - 1 'boucle pour ajouter le nombre de dossier avant la chaine de réduction PathRaccourci = PathRaccourci & Tmp(i) & Delimiteur Next i PathRaccourci = PathRaccourci & RemplacerPar & Delimiteur & Tmp(UBound(Tmp())) 'on ajout les points de suspension et le dernier dossier If DelimiteurDeFin = True Then 'si on demande d'ajouter le délimiteur à la fin du chemin, eh bien on le fait PathRaccourci = PathRaccourci & Delimiteur End If 'traitement spécial pour les URLs internet (on rajoute le slash qui manque) If Left(LCase(Path), 5) = "http:" Then PathRaccourci = Left(PathRaccourci, 5) & Delimiteur & Right(PathRaccourci, Len(PathRaccourci) - 5) ElseIf Left(LCase(Path), 4) = "ftp:" Then PathRaccourci = Left(PathRaccourci, 4) & Delimiteur & Right(PathRaccourci, Len(PathRaccourci) - 4) End If RaccourcirPath = PathRaccourci End Function
22 mai 2009 à 16:24
http://www.vbfrance.com/codes/ELLIPSIS-COMMENT-TRONQUER-CHAINE-CARACTERES_40307.aspx
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.