Mit dieser Funktion lässt sich eine Pfadangabe auf eine bestimmte max. Länge kürzen, wobei man auf die gekürzte Anzeige selbst Einfluß nehmen kann. Public Function PfadKurz(ByVal sPath As String, _ ByVal Max_Len As Integer, _ Optional Is_File As Boolean = False, _ Optional ANZ_VR As Integer = 2) As String ' Pfad auf gewünschte Länge bringen, falls notwendig ' bzw. sinnvoll ' ' Verzeichnis-Pfade können mit und ohne "\" am Ende ' eingegeben werden. ' Die Ausgabe ist dann entsprechend mit bzw. ohne ' "\" am Ende. ' ' Die Funktion legt den linken und rechten Anteil der ' Pfadangabe jeweils mit der gewünschten max. Länge in 2 ' ("benachbarte") Spalten eines Datenfeldes und sucht dann ' rein bildlich gesehen den richtigen Platz (Zeilen), die ' mit den 3 Punkten zu versehen sind. ' ' (Nach Regeln: Wieviele Verzeichnisse bzw. "\" sollen von ' rechts übernommen werden usw.) ' ' PARAMETER: ' ' sPath zu kürzender Pfad-String ' ' Max_Len maximale Anzahl Ausgabe-Zeichen ' ' Is_File True, falls es sich bei "sPath" um ' Pfad+Dateiname handelt ' False, falls es sich bei "sPath" um eine ' reine Verzeichnis-Angabe handelt ' ' ANZ_VR Anzahl Verzeichnisangabnen, die auf der rechten ' Seite möglichst vollständig angezeigt werden sollen ' ' -> Mein Geschmack geht dahin: ' Verzeichnis-Pfade: 2 (Verzeichnisse rechts anzeigen) ' Datei-Pfade: 1 (Verzeichnis rechts anzeigen) '------------------------------------------------------------------- Dim i As Integer ' Zähler Dim L As Integer ' letzte von LINKS bereits erledigte Zeichen-Position Dim R As Integer ' letzte von RECHTS bereits erledigte Zeichen-Position Dim z As Integer ' Zähler für Schrägstriche "\" von rechts Dim Strg_Fld() ' Feld mit den Pfad-Zeichen ' Strg_Fld(0, n) 0- Spalte Auszugebener gekürzter Pfad ' Strg_Fld(1, n) 1- Spalte Zeichen linker Anteil ' Strg_Fld(2, n) 2- Spalte Zeichen rechter Anteil Dim X As String ' Ausgabe-String Dim Max_L As Integer ' Maximale Länge intern Dim ANZ_SInt As Integer ' Anzahl Schrägstriche von Rechts PfadKurz = sPath If Len(sPath) = 0 Or Len(sPath) <= Max_Len Then ' keine Überlänge Exit Function End If If Max_Len < 10 Then ' extrem kurz, nur rechten Anteil ausgeben If Max_Len < 3 Then Max_Len = 3 PfadKurz = "..." & Right(sPath, Max_Len - 3) Exit Function End If Max_L = Max_Len ' Maximale Länge intern ANZ_SInt = ANZ_VR + 1 If Is_File = False And Not Right$(sPath, 1) = "\" Then ' Rechts ein \, falls sPath Verzeichnis sein soll sPath = sPath & "\" Max_L = Max_L + 1 ' Maximale Länge intern End If ReDim Strg_Fld(2, Max_L) ' ------------- Feld füllen -------------------------------------- For i = 1 To UBound(Strg_Fld, 2) ' Zeichen linker Anteil Strg_Fld(1, i) = Mid(sPath, i, 1) ' Zeichen rechter Anteil Strg_Fld(2, i) = Mid(sPath, (Len(sPath) + i) - Max_L, 1) Next i ' *** Jetzt muss entschieden werden, wo die 3 Punkte "..." hinkommen *** ' Laufwerk auf jeden Fall If Mid$(sPath, 2, 1) = ":" Then For i = 1 To 3 Strg_Fld(0, i) = Strg_Fld(1, i) ' z.B: "C:\" Next i ' letzte von LINKS bereits erledigte Zeichen-Position L = 3 End If ' Versuch: RECHTS-Verzeichnis(se) unterzubringen mit ' Schrägstrichen "\..\" bzw "\.." z = 0 ' Zähler für Schrägstriche "\" von rechts For i = Max_L To L + 1 Step -1 If z = ANZ_SInt Or i = 6 Then ' ANZ_SInt x "\" rechts reicht aus ' bzw. Zeichen 4,5,6 bleiben (noch) reserviert Exit For End If Strg_Fld(0, i) = Strg_Fld(2, i) ' letzte von RECHTS bereits erledigte Zeichen-Position R = i If Strg_Fld(0, i) = "\" Then z = z + 1 ' Zähler für Schrägstriche "\" von rechts End If Next i ' Versuchen, mit LINKS-Verzeichnis(sen) den restlichen Platz ' in der 0-Spalte aufzufüllen For i = L + 1 To R - 1 ' Nur im noch freien Bereich arbeiten If R - L <= 4 Then Strg_Fld(0, i) = "." Else Strg_Fld(0, i) = Strg_Fld(1, i) End If ' letzte von LINKS bereits erledigte Zeichen-Position L = i Next i ' --- Ausgabe-String aus 0-Spalte entwickeln ------------------- For i = 1 To Max_Len ' Ausgabe für orig. Länge Max_Len ! X = X & Strg_Fld(0, i) Next i PfadKurz = X End Function Aufrufbeispiel: Dim sFile As String sFile = "C:\Dokumente und Einstellungen\All Users\Anwendungsdaten\Excel.xls" Label1.Caption = PfadKurz(sFile, 40, True, 1) Dieser Tipp wurde bereits 15.312 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
sevGraph (VB/VBA) Grafische Auswertungen Präsentieren Sie Ihre Daten mit wenig Aufwand in grafischer Form. sevGraph unterstützt hierbei Balken-, Linien- und Stapel-Diagramme (Stacked Bars), sowie 2D- und 3D-Tortendiagramme und arbeitet vollständig datenbankunabhängig! Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 TOP Entwickler-Paket TOP-Preis!! Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR... |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |