Office: (Office 2003) String auf gültige Zeichen prüfen

NorbertK · 18. April 2015

Hallo allerseits,

heute kam eine neue Anforderung auf den Tisch: Der Objektname (Feld = Objekt) soll als Teil des Namens für die Berichte verwendet werden. Eigentlich kein Problem und ich habe es auch bereits in die Druckfunktion integriert, aber da gibt es ja die "bösen" Zeichen (\ / : * ? "< > |) und selbstverständlich wurden diese auch schon zu genüge verwendet.

Wie kann ich beim Zusammensetzen des Berichtnamens diese unerlaubten Zeichen entfernen (am besten nur für die Funktion des Drucks und nicht generell im Feld)?

:)

Kimba06 · 20. April 2015

Hallo Norbert,
wenn Du dir eine abfrage baust auf dein Feld und folgenden Ausdruck eingibst, solltest Du es hinbekommen Code:

Ausdr1: Ersetzen([Tabelle1]![Feld1];"/";"")
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

im Beispiel habe ich ein "/" als Sonderzeichen gewählt. Du kannst die Funktion ja noch durch entsprechende Und Bedingungen erweitern.
Gruss Achim

gpswanderer · 20. April 2015

Hallo,
erstelle Dir eine Funktion die mit Replace die ungültigen Zeichen durch einen Leerstring ersetzt.
Code:

Public Function fncSonderZErs(strObjekt As String) As String
fncSonderZErs = Replace(strObjekt, "\", "")
fncSonderZErs = Replace(fncSonderZErs, "/", "") 'ab Zeile 2 nicht mehr strObjekt verwenden
fncSonderZErs = Replace(fncSonderZErs, ".", "")
fncSonderZErs = Replace(fncSonderZErs, ":", "") 'diese Zeile für jedes Sonderzeichen wiederholen
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

In einer Abfrage dann als berechnetes Feld:
Code:

BerichtsnameoZz: fncSonderZErs([Objekt])
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Für den Berichtsnamen verwendest Du dann das Feld "BerichtsnameoZz".
Die Abfrage sollte natürlich alle für den Bericht erforderlichen Tabellen und Felder enthalten.

Möglicherweise gibt es auch elegantere Lösungen (z.B. reguläre Ausdrücke) aber da habe ich keine Erfahrung.

Maxel · 20. April 2015

Alternativ zu dieser "negativen" Methode, ungültige Zeichen zu entfernen, kannst Du auch die "positive" Methode anwenden, nur gültige Zeichen zuzulassen.

Dabei müsstest Du den Text per Schleife Zeichen für Zeichen durchlaufen und prüfen, ob ein gültiges Zeichen vorliegt. Gültige Zeichen lassen sich per Chr()-Funktion ermitteln, z. B.

Code:

0...9 = CHR(48)...CHR(57)
A...Z = CHR(65)...CHR(90)
a...z = CHR(97)...CHR(122)
Ä = CHR(195)
ä = CHR(227)
...
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Der Vorteil dieser Methode besteht darin, dass kein ungültiges Zeichen vergessen wird anzugeben.

Du kannst die Zeichen auch schon bei der Eingabe abfangen, z. B.
Code:

Private Sub txtBox_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 65 To 90 ' A-Z zulassen
Case 97 To 122 ' a-z zulassen
Case 150 ' - zulassen
Case Else ' alles andere ablehnen
KeyAscii = 0
End Select
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Du kannst den letzteren Code auch sinngemäß auf die Zeichenprüfung (s. o.) anwenden.

WeinGeist · 20. April 2015

RegEx wäre eine Möglichkeit. Kleines Beispiel-Modul:
Code:

Private m_oRegEx As Object

'Textanalyse / Ersetzungen
'Nachfolgend sind einige Hilfsfunktionen, die jeweils eine Methode eines RegEx-Objektes kapseln und so für verschiedenste Anwendungsformen wie z.B. Abfragen,
'Schleifen und natürlich auch Einzelaufrufe anbieten.
'Die vorangestellte Property stellt ein RegEx-Objekt zur Verfügung, auf das dann ständig zugegriffen werden kann.
'Damit erzielt man u.a. Performancevorteile gegenüber der Variante, dass man dieses Objekt in einer Funktion erzeugt und diese Objekterzeugung pro Funktionsaufruf wiederholt würde.

Private Property Get oRegEx() As Object
If (m_oRegEx Is Nothing) Then Set m_oRegEx = CreateObject("Vbscript.Regexp")
Set oRegEx = m_oRegEx
End Property

Public Function RegExTest(ByVal SourceText As String, _
ByVal SearchPattern As String, _
Optional ByVal bIgnoreCase As Boolean = True, _
Optional ByVal bGlobal As Boolean = True, _
Optional ByVal bMultiLine As Boolean = True) As Boolean

With oRegEx
.Pattern = SearchPattern
.IgnoreCase = bIgnoreCase
.Global = bGlobal
.MultiLine = bMultiLine
RegExTest = .Test(SourceText)
End With
End Function

Public Function RegExReplace(ByVal SourceText As String, _
ByVal SearchPattern As String, _
ByVal ReplaceText As String, _
Optional ByVal bIgnoreCase As Boolean = True, _
Optional ByVal bGlobal As Boolean = True, _
Optional ByVal bMultiLine As Boolean = True) As String

With oRegEx
.Pattern = SearchPattern
.IgnoreCase = bIgnoreCase
.Global = bGlobal
.MultiLine = bMultiLine
RegExReplace = .Replace(SourceText, ReplaceText)
End With
End Function

Public Function RegExMatchCollection(ByVal SourceText As String, _
ByVal SearchPattern As String, _
Optional ByVal bIgnoreCase As Boolean = True, _
Optional ByVal bGlobal As Boolean = True, _
Optional ByVal bMultiLine As Boolean = True) As Object

With oRegEx
.Pattern = SearchPattern
.IgnoreCase = bIgnoreCase
.Global = bGlobal
.MultiLine = bMultiLine
Set RegExMatchCollection = .Execute(SourceText)
End With
End Function

'###### Tests
'RegExTest:
'Hier wird einfach getestet, ob das Suchmuster (Pattern) im zu analysierenden Text vorkommt.
'Beispiel: Es gibt einen zu testenden Artikel "Pullover Rot". Jetzt soll getestet werden, ob er einer der Wahlfarben rot, blau oder gelb entspricht.
'Aufruf:
Public Sub aufruf_RegExTest()
Dim Teststring As String
Teststring = "Pullover Rot"

If RegExTest(Teststring, "(rot|blau|gelb)$", True) Then
Debug.Print "Treffer"
Else
Debug.Print "no"
End If
End Sub

'RegExReplace:
'Das Ersetzen erfolgt recht ähnlich zu der Replace-Methode von VBA, ist allerdings um einiges variabler und differenzierter.
'Beispiel: In einem Text will man ein Wort ersetzen. Das VBA-Replace ersetzt alle gefundenen Zeichenfolgen ohne Rücksicht darauf, ob die Zeichenfolge ein
'eigenes Wort oder nur Teil eines Wortes ist. RegEx kann da unterscheiden.
'Aufruf: \b heisst * unterdrücken, beidseitig = ganzes wort
Public Sub aufruf_RegExReplace()
Dim Textstring As String
Textstring = "Es ist super, von einem Superhirn zu profitieren."

Textstring = RegExReplace(Textstring, "\bsuper\b", "gigantisch")
Debug.Print Textstring
End Sub

'RegExMatchCollection:
'Die Methode Execute erzeugt eine Matchcollection (Auflistung von Treffern). Dabei ist eine solche Matchcollection etwas anderes als eine VBA.Collection.
'Zur Auswertung einer Matchcollection muss man eine zusätzliche Funktion aufsetzen, die dann auswählt, welche der vielen Informationen der
'Matchcollection (Anzahl der Treffer, Trefferauflistung, einige Zusatzangaben zu Treffern wie Länge und Startposition im Text, Teiltreffer bei Subpattern) weiterverwendet
'werden sollen und wie die Ausgabe bzw. Nutzung der Ergebnisse erfolgen soll.
'Beispiel: Ein zu analysierender Text enthält Teilinformationen. Für einen weiteren Text, der die Teilinformationen semikolongetrennt enthält, soll ermittelt werden,
'wieviele übereinstimmende Teilinformationen zum anderen Text bestehen, um z.B. eine Ähnlichkeit quantifizieren zu können.
'Aufruf:
Public Sub AnzahlUebereinstimmungen()
Dim sToFind As String
Dim sFindIn As String
sFindIn = "AX1;AX5 CX3,BX4;GH7-HZ4"
sToFind = "AX1;AX5;CX3;DX8"

Debug.Print CountOccur(sToFind, sFindIn)
End Sub
Public Function CountOccur(ByVal ToFind As String, ByVal FindIn As String) As Long
Dim oMC As Object
Dim sResPattern As String
sResPattern = "(" & Join(Split(ToFind, ";"), "|") & ")"
Set oMC = RegExMatchCollection(FindIn, sResPattern)
CountOccur = oMC.Count
Set oMC = Nothing
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ist ganz nett und ziemlich zackig bei vielen Ersetzungen. Habe jetzt nie explizite Messvergleiche gemacht, würde aber sagen, dass sie schneller sind als Replace sobald vieles ersetzt werden muss wird. Und halt nen Einzeiler anstelle vieler Zeilen.

Hab leider keine Ahnung mehr wo ich das herhabe...

ebs17 · 20. April 2015

Hab leider keine Ahnung mehr wo ich das herhabe...
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich habe das schon mal gesehen: Klick mich

WeinGeist · 7. Januar 2021

von ebs17

Ich habe das schon mal gesehen: Klick mich
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

*grins

Habs gleich mal in mein Modul eingefügt, dann weiss ichs nächstes mal. Thanks!

NorbertK · 20. April 2015

Hallo Leute,

tausend Dank für die hohe Reaktion und die tollen Tipps!

Nach etwas Probieren habe ich mich für die Lösung von Klaus entschieden. Allerdings etwas modifiziert:
In meinem Modul Allgemein habe ich die Function untergebracht:
Code:

Public Function fncSonderZErs(strObjekt As String) As String
On Error GoTo Fehler

' \ ersetzen
fncSonderZErs = Replace(strObjekt, "\", "")
' / ersetzen
fncSonderZErs = Replace(fncSonderZErs, "/", "")
' . ersetzen
fncSonderZErs = Replace(fncSonderZErs, ".", "")
' : ersetzen
fncSonderZErs = Replace(fncSonderZErs, ":", "")
' * ersetzen
fncSonderZErs = Replace(fncSonderZErs, "*", "")
' ? ersetzen
fncSonderZErs = Replace(fncSonderZErs, "?", "")
' " ersetzen
fncSonderZErs = Replace(fncSonderZErs, """", "")
' < ersetzen
fncSonderZErs = Replace(fncSonderZErs, "", "")
' | ersetzen
fncSonderZErs = Replace(fncSonderZErs, "|", "")
' ² ersetzen
fncSonderZErs = Replace(fncSonderZErs, "²", "")
' ³ ersetzen
fncSonderZErs = Replace(fncSonderZErs, "³", "")
' = ersetzen
fncSonderZErs = Replace(fncSonderZErs, "=", "")

Ende:
Exit Function

Fehler:
MsgBox Err.Description
Resume Ende
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

und in den jeweiligen Formularen habe ich zwei (unsichtbare) Felder:
1 x txtObjekt mit dem Inhalt Code:

[Objekt]
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

1 x txtObjektReplace mit dem Inhalt Code:

=fncSonderZErs([txtObjekt])
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Und der Berichtsname wird durch diese Zeile zusammengesetzt:
Code:

MyFileBerichtFertig = "Prüfbericht " & Me.Pruef_ID & " - " & Me.txtObjektReplace & " - BGV A3 (Ortsveränderliche Betriebsmittel)" & ".pdf"
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Jetzt habe ich, was ich wollte und kann getrost mit den Sonderzeichen im Objektnamen leben; er wird auch nur in den beiden Feldern temporär geändert und bleibt in der Tabelle im Originalzustand - also alles wie gewünscht.

Nochmals Danke!

Office: (Office 2003) String auf gültige Zeichen prüfen

String auf gültige Zeichen prüfen

String auf gültige Zeichen prüfen

String auf gültige Zeichen prüfen

String auf gültige Zeichen prüfen

String auf gültige Zeichen prüfen - Similar Threads - String gültige Zeichen

Teile aus einem qrcode string auslesen

VBA Auslesen von Strings und erstellen neuer Zeilen in einer Tabelle

mit String aus Formular Übereinstimmung in Abfrage prüfen

Leerzeichen abschließend im String

If-Then-Else...Verständnisfrage zu Kriterium String > Zahl

Erlaubte Zeichen an bestimmten Stellen von Strings

Mitarbeiterauslastung: Suchen nach String und addieren aller zugehörigen Zahlenwerte