[<>]
====== [VBA] rx_replace_callback() ======
Die Erweiterung von [[.:rx_replace]] ist das rx_replace_callback(). Damit kann man alle Treffer einer 
Callback-Funktion übergeben. Die Submatches sind die Argumente, welche der Funktion übergeben werden

>Übersicht über alle rx-Funktionen: [[..:rx:]]
> Für die Ausgabe der Resultate verwendete ich die Funktion [[:vba:functions:print_r:]]

><wrap hi>Die Funktion rx_replace_callback() verwendet den MS Access-Befehl eval(). In anderen Applikationen läuft
 sie nicht.</wrap> Alternativ kann man die Funktion aus MS Access einbinden (sofern MS Access auf dem Rechner isntalliert ist): [[:vba:accessfunctionsinexcel]]
===== Definitionen =====
<code vb>Public Function preg_replace_callback( _
	ByVal iPattern As String, _
	ByRef iCallback As Variant, _
	ByVal iSubject As String, _
        Optional ByVal iArrayFlags As rxArrayEnum = rxIncludeSubmatches _
) As String</code>
==== Parameter-Liste ====
  ***iPattern** Der Reguläre Ausdruck, mit dem gesucht wird
  ***iCallback ** Name der Funktion die mit jedem Treffer aufgerufen werden soll
  ***iSubject** Der Text der durchsucht werden soll
  ***//iFlags //** Eigenschaften von Regexp. Global, IgnoreCase und Multiline. Die Eigenschaften können mit + kombiniert werden

==== Enumeratoren ====
=== rxFlagsEnum ===
<nowiki>Setzte die Flags für das RegExp Object. Für das genaue Verhalten bitte die VB-Doku zur RegExp Klasse studieren</nowiki>
  ***rxNone** Alle Parameter werden auf False gesetzt. Wird vor allem zum überschreiben des Standards gebraucht.
  ***rxGlobal** Setzt Global(([[http://msdn.microsoft.com/en-us/library/tdte5kwf(v=vs.84).aspx|Global Property auf MSDN]])) auf True
  ***rxIgnorCase**  Setzt <nowiki>IgnorCase</nowiki>(([[http://msdn.microsoft.com/en-us/library/wy1d4bz3(v=vs.84).aspx|IgnorCase Property auf MSDN]])) auf True
  ***rxMultiline**  Setzt Multiline auf True
===== Anwendungsbeispiele =====
Ich habe eine Funktion getMin(v1,v2) welche den kleineren der Beiden Werte zurückgibt.
Nun will ich in einem Text alle 'zwischen v1 und v2' damit berechnen lassen und ersetzen.
<code vb>Dim txt as String: txt = "wir haben zwischen 1 und 4 Biere und zwischen 5 und 3 Weine"
debug.print rx_replace_callback("zwischen (\d+) und (\d+)", "getMin", txt)</code>
  *Eingabe: 'wir haben zwischen 1 und 4 Biere und zwischen 5 und 3 Weine'
  *Ausgabe: 'wir haben 1 Biere und 3 Weine'

<code vb>
Public Function createOfficeEmail(ByVal iNachname As String, ByVal iVorname As String) As String
    Dim rndId As Integer
    Randomize
    rndId = Int((9 * Rnd) + 1)  'Zahl zwischen 1 und 9
    createOfficeEmail = iVorname & "." & iNachname & "." & rndId & "@myOffice.com"
End Function

Dim txt As String
txt = "Erb Stefan, Yaslaw Kowalejeff, Peter Maier"
Debug.Print rx_replace_callback("(\w+) (\w+)", "createOfficeEmail", txt)
'Ausgabe:
'Stefan.Erb.1@myOffice.com, Kowalejeff.Yaslaw.3@myOffice.com, Maier.Peter.4@myOffice.com</code>

===== Code =====
<code vb preg_replace_callback.bas>
'/**
' * Copyright mpl by ERB software | http://wiki.yaslaw.info
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/pregreplacecallback
' * Führt eine Callback-Funktion über alle Trefferelemente aus und ersetzt diese im Text
' * @example            Ein Beispiel. ich habe eine Funktion getMin(v1,v2) welche den kleineren der Beiden Werte zurückgibt.
' *                     Nun will ich in einem Text alle 'zwieschen v1 und v2' damit berechnen lassen und ersetzen
' *                     Print preg_replace_callback("zwieschen (\d) und (\d)", "getMin", "wir haben zwieschen 1 und 4 Biere und zwieschen 5 und 3 Weine")
' *                     Eingabe: 'wir haben zwieschen 1 und 4 Biere und zwieschen 5 und 3 Weine'
' *                     Ausgabe: 'wir haben 1 Biere und 3 Weine'
' * @param  String      Pattern analog RegExp
' * @param  String      Name der Callback-Funktion
' * @param  String      Der String der bearbeitet werden soll
' * @param  Boolean     Multiline-Eigenschaft von RegExp
' * @param  Boolean     IgnoreCase-Eigenschaft von RegExp
' * @param  Boolean     Global-Eigenschaft von RegExp
' * @return String
' */
Public Function rx_replace_callback( _
        ByVal iPattern As String, _
        ByRef iCallback As Variant, _
        ByVal iSubject As String, _
        Optional ByVal iFlags As rxFlagsEnum = rxGlobal + rxIgnorCase _
) As String
    'Dim rx      As New regExp
    'Dim mc      As MatchCollection
    'Dim m       As Match
    Dim rx      As Object: Set rx = CreateObject("VBScript.RegExp")
    Dim mc      As Object
    Dim m       As Object
    Dim smc()   As String
    Dim ret     As String
    Dim i, k

    rx.Global = iFlags And rxGlobal
    rx.IgnoreCase = iFlags And rxIgnorCase
    rx.Multiline = iFlags And rxMultiline

    rx.Pattern = iPattern
    Set mc = rx.execute(iSubject)

    rx_replace_callback = iSubject
    For i = mc.count - 1 To 0 Step -1
        Set m = mc.Item(i)
        'Alle Submatches zu Argumenten zusammenführen
        ReDim smc(m.SubMatches.count - 1)
        For k = 0 To UBound(smc): smc(k) = """" & m.SubMatches(k) & """": Next k
        ret = CStr(Eval(iCallback & "(" & join(smc, ",") & ")"))
        'Unterstring ersetzen
        rx_replace_callback = Left(rx_replace_callback, m.FirstIndex) & ret & Mid(rx_replace_callback, m.FirstIndex + m.Length + 1)
    Next i

    Set m = Nothing
    Set mc = Nothing
    Set rx = Nothing

End Function
</code>
{{tag>VBA:Functions VBA:RegExp VBA}}