User Tools

Site Tools


vba:cast:techname

This is an old revision of the document!


[VBA] techName()

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

Definition

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
  • iName Name der gewandelt werden soll
  • iMaxLen Maximale Länge
  • iStrConv Art der Konvertierung. Lower/Uper/Proper-Case
  • iClearCache Flag, ob der ObjectCache geleert werden soll. Wird nur zum testen der Funktion gebraucht

Beispiele

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'

Code

udf_techName.bas
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
vba/cast/techname.1401287133.txt.gz · Last modified: 28.05.2014 16:25:34 (external edit)