This is an old revision of the document!
Erstellt aus einem String ein Technischer Name. Ersetzt Leer- und Sonderzeichen durch _, kürzt aus vorgegebene Länge, etc.
techName(iName[, iMaxLen][, iStrConv][, iClearCache])
Public Function techName( _ ByVal iName As String, _ Optional ByVal iMaxLen As Integer = 255, _ Optional ByVal As tnStrConv = vbUpperCase, _ Optional ByVal iClearCache As Boolean = False _ ) As String
In dem Beispiel mache ich aus dem folgenden Text einen technischen Namen
Bücherpreis [CHF] bei Sofortkauf!!!
'Standart print_r techName("Bücherpreis [CHF]" & vbcrlf & "bei Sofortkauf!!!") <String> 'BUECHERPREIS_CHF_BEI_SOFORTKAUF' 'auf 16 Zeichen begrenzt print_r techName("Bücherpreis [CHF]" & vbcrlf & "bei Sofortkauf!!!",16) <String> 'BUECHERPREIS_CHF' 'und Kleinbuchstaben print_r techName("Bücherpreis [CHF]" & vbcrlf & "bei Sofortkauf!!!",16, vbLowerCase) <String> 'buecherpreis_chf'
Attribute VB_Name = "udf_techName" '------------------------------------------------------------------------------- 'File : udf_techName.bas ' Copyright mpl by ERB software ' All rights reserved ' http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/strtodate 'Environment : VBA 2007 + 'Version : 1.1 'Name : techName 'Author : Stefan Erb (ERS) 'History : 05.05.2014 - ERS - Creation ' 28.05.2014 - ERS - tnStrConv hinzugefügt um die unnützen Einträge aus VbStrConv rauszufiltern '------------------------------------------------------------------------------- Option Explicit Private cacheDictUmlaute As Object Private cacheRxNonWords As Object Private cacheRxTrim As Object Public Enum tnStrConv vbUpperCase = VbStrConv.vbUpperCase vbLowerCase = VbStrConv.vbLowerCase End Enum '/** ' * Erstellt aus einem String einen technischen Namen ' * @param String Name der gewandelt werden soll ' * @param Integer Maximale Länge ' * @param VbStrConv Art der Konvertierung. Lower/Uper/Proper-Case ' * @param Boolean Floag, ob der ObjectCache geleert werden soll. Wird nur zum testen der Funktion gebraucht ' * @return String ' */ Public Function techName( _ ByVal iName As String, _ Optional ByVal iMaxLen As Integer = 255, _ Optional ByVal iStrConv As tnStrConv = vbUpperCase, _ Optional ByVal iClearCache As Boolean = False _ ) As String 'Cache der Übersetzungen initialisieren If cacheDictUmlaute Is Nothing Or iClearCache Then Set cacheDictUmlaute = CreateObject("scripting.Dictionary") With cacheDictUmlaute 'Hier weitere Umsetzungen programmieren. Alle in LowerCase .add "ä", "ae": .add "ö", "oe": .add "ü", "ue": .add "ß", "ss": .add "é", "e": .add "è", "e" End With End If 'Chache des Patterns initializieren If cacheRxNonWords Is Nothing Or iClearCache Then Set cacheRxNonWords = CreateObject("VBScript.RegExp") cacheRxNonWords.pattern = "([\W_]+)" cacheRxNonWords.Global = True End If If cacheRxTrim Is Nothing Or iClearCache Then Set cacheRxTrim = CreateObject("VBScript.RegExp") cacheRxTrim.pattern = "^_*((?:[A-Z]|_(?!$))*)_*$" End If techName = LCase(iName) 'Umlaute entfernen Dim k As Variant: For Each k In cacheDictUmlaute.keys techName = Replace(techName, k, cacheDictUmlaute.item(k)) Next k 'String Convertierung techName = StrConv(techName, iStrConv) 'Alle Nicht-Buchstaben durch _ ersezuen techName = cacheRxNonWords.Replace(techName, "_") 'Führende und folgende _ entfernen techName = cacheRxTrim.Replace(techName, "$1") 'ggf Länge reduzieren techName = Left(techName, iMaxLen) End Function