Erstellt aus einem String ein Technischer Name. Ersetzt Leer- und Sonderzeichen durch _, kürzt aus vorgegebene Länge, übersetzt Umlaute etc.

Download cast_techname.bas (V-2.1.0)

Siehe auch [VBA] readableName()

techName(iName[, iMaxLen[, iStrConv[, iDelemiter]]])

Public Function techName( _
        ByVal iName As String, _
        Optional ByVal iMaxLen As Integer = 255, _
        Optional ByVal iStrConv As tnStrConv = vbUpperCase, _
        Optional ByVal iDelemiter As Variant = Null _
) As String

• iName Name der gewandelt werden soll
• iMaxLen Maximale Länge
• iStrConv Art der Konvertierung. Lower/Uper/Proper-Case
• iDelemiter Deleimter. Default: Bei Proper Case “” ansonsten “_” gebraucht

Der Enum ist eigentlich nur eine Auswahl aus vbStrConv

Public Enum tnStrConv
    vbUpperCase = VbStrConv.vbUpperCase     'Alles in Grossbuchstaben       -> Standarddelimiter: "_"
    vbLowerCase = VbStrConv.vbLowerCase     'Alles in Kleinbuchstaben       -> Standarddelimiter: "_"
    vbProperCase = VbStrConv.vbProperCase   'Immer erster Buchstabe klein   -> Standarddelimiter: ""
End Enum

Für die Beispiele verwende ich [VBA] print_r()

In dem Beispiel mache ich aus dem folgenden Text einen technischen Namen

Bücherpreis [CHF]
bei  Sofortkauf!!!

'Standard. Mit UpperCase und _ als Delemiter
d techName("Bücherpreis [CHF]" & vbcrlf & "bei  Sofortkauf!!!")
<String> 'BUECHERPREIS_CHF_BEI_SOFORTKAUF'
 
'Auf 15 Zeichen abgeschnitten
d techName("Bücherpreis [CHF]" & vbcrlf & "bei  Sofortkauf!!!", 15)
<String> 'BUECHERPREIS_CH'
 
'Lowercase und als Trennzeichen ein -
d techName("Bücherpreis [CHF]" & vbcrlf & "bei  Sofortkauf!!!",,vbLowerCase, "-")
<String> 'buecherpreis-chf-bei-sofortkauf'
 
'ProperCase. Standarddelmiter ist den dem Fall "". Ergibt also ein CamelCase
d techName("Bücherpreis [CHF]" & vbcrlf & "bei  Sofortkauf!!!",,vbProperCase)
<String> 'BuecherpreischfBeiSofortkauf'

cast_techname.bas

Attribute VB_Name = "cast_techName"
'-------------------------------------------------------------------------------
'File         : cast_techName.bas
'               Copyright mpl by ERB software
'               All rights reserved
'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/techName
'Environment  : VBA 2007 +
'Version      : 2.1.0
'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
'               11.06.2014 - ERS - Trim erweitert, damit er auch mit Zahlen richtig funktioniert
'               31.10.2014 - ERS - Cache durch Static ersetzt
'               20.11.2015 - ERS - Delemiter als neuer Paramter hinzugef�gt, eineige �berarbeitet
'               03.01.2017 - ERS - Korrektuf f�r vbPropertCase
'-------------------------------------------------------------------------------
Option Explicit
 
'Auswahl der elraubten StrConv
Public Enum tnStrConv
    vbUpperCase = VbStrConv.vbUpperCase
    vbLowerCase = VbStrConv.vbLowerCase
    vbProperCase = VbStrConv.vbProperCase
End Enum
 
'/**
' * Erstellt aus einem String einen technischen Namen
' * @param  String      Name der gewandelt werden soll
' * @param  Integer     Maximale L�nge
' * @param  tnStrConv   Art der Konvertierung. Lower/Uper/Proper-Case
' * @param  String      Deleimter. Default: Bei Proper Case '' ansonsten '_'
' * @return String
' */
Public Function techName( _
        ByVal iName As String, _
        Optional ByVal iMaxLen As Integer = 255, _
        Optional ByVal iStrConv As tnStrConv = vbUpperCase, _
        Optional ByVal iDelemiter As Variant = Null _
) As String
    Static rxNonWords  As Object:   If rxNonWords Is Nothing Then Set rxNonWords = cRx("/([\W_]+)/g")
    Static rxTrim As Object:        If rxTrim Is Nothing Then Set rxTrim = cRx("/(^[\W_]+|[\W_]+$)/g")
    Dim delimiter As String:        delimiter = NZ(iDelemiter, IIf(iStrConv = vbProperCase, "", "_"))
 
    techName = LCase(iName)
 
    'Umlaute entfernen
    Dim k As Variant: For Each k In dictUmlaute.keys
        techName = replace(techName, k, dictUmlaute.item(k))
    Next k
 
    'F�r den strConv die Nicht-W�rter durch " " ersetzen
    techName = rxNonWords.replace(techName, " ")
 
    'String Convertierung
    techName = StrConv(techName, iStrConv)
 
    'Alle Nicht-Buchstaben durch _ oder '' ersezuen
    techName = rxNonWords.replace(techName, delimiter)
    'F�hrende und folgende Delemiter entfernen
    techName = rxTrim.replace(techName, "")
 
    'ggf L�nge reduzieren
    techName = Left(techName, iMaxLen)
 
End Function
 
'Cachehandling
 
Private Property Get dictUmlaute() As Object
    Static cacheDictUmlaute As Object:
    If cacheDictUmlaute Is Nothing Then
        Set cacheDictUmlaute = CreateObject("scripting.Dictionary")
        With cacheDictUmlaute
            'Hier weitere Umsetzungen programmieren. Alle in LowerCase. Umlaut:�bersetzung
            .add "�", "ae": .add "�", "oe": .add "�", "ue": .add "�", "ss": .add "�", "e": .add "�", "e"
        End With
    End If
    Set dictUmlaute = cacheDictUmlaute
End Property
 
'/**
' * Dies ist die Minimalversion von cRegExp
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/cregexp#abgespeckte_version
' * m�gliche Delemiter: @&!/~#=\|
' * m�gliche Modifiers: g (Global), i (IgnoreCode, m (Mulitline)
' *
' * @example    myRx = cRx("/([a]{2,})/i") 'Finde alle folgen von a. Flag:IgnoreCase
' * @version    2.1.0 (01.12.2014)
' * @param      String      Pattern mit Delimiter und Modifier analog zu PHP
' * @return     Object      RegExp-Object
' */
Private Function cRx(ByVal iPattern As String) As Object
    Static rxP As Object:       Set cRx = CreateObject("VBScript.RegExp")
    If rxP Is Nothing Then:     Set rxP = CreateObject("VBScript.RegExp"): rxP.pattern = "^([@&!/~#=\|])?(.*)\1(?:([Ii])|([Gg])|([Mm]))*$"
    Dim sm As Object:           Set sm = rxP.Execute(iPattern)(0).subMatches
    cRx.pattern = sm(1):        cRx.IgnoreCase = Not isEmpty(sm(2)):       cRx.Global = Not isEmpty(sm(3)):     cRx.Multiline = Not isEmpty(sm(4))
End Function