Public Function ldSostituisciStringa(ByVal strTesto As String, _
ByVal strTrova As String, _
ByVal strSostituisci As String, _
Optional ByVal fIgnoraMaiuscole As Boolean = False, _
Optional ByVal fAutoTest As Boolean = False _
) As String
' Autore: Luca Dall'Olio
' email: dalloliol@bigfoot.com
' Dalla originale SostituisciStringa di Lbo
' La modalita' autotest ignora i parametri ed esegue un check
' interno, sollevando eccezioni in caso di errori.
Dim strRicerca As String
Dim strPrima As String
Dim strDopo As String
Dim lngPivot As Long
Const errldSostituisciStringaAutotest As Long = 1000 + vbObjectError
' Modalita' autotest
If fAutoTest Then
' Autotest modalita' case insensitive
If ldSostituisciStringa("XXpippoXXpippopippoXXpiPpo", _
"pippo", "pLuto") <> _
"XXpLutoXXpLutopLutoXXpiPpo" Then
Err.Raise errldSostituisciStringaAutotest, _
"ldSostituisciStringa", _
"Errore nell'autotest (case insensitive)"
End If
' Autotest modalita' case sensitive
If ldSostituisciStringa("XXPipPoXXpiPPoPIPPOXXpippo", _
"PippO", "Pluto", True) <> _
"XXPlutoXXPlutoPlutoXXPluto" Then
Err.Raise errldSostituisciStringaAutotest, _
"ldSostituisciStringa", _
"Errore nell'autotest (case sensitive)"
End If
' Autotest con stringa destinazione vuota.
If ldSostituisciStringa("XXPipPoXXpiPPoPIPPOXXpippo", _
"PippO", "", True) <> _
"XXXXXX" Then
Err.Raise errldSostituisciStringaAutotest, _
"ldSostituisciStringa", _
"Errore nell'autotest (sostituisci una stringa vuota)"
End If
' Autotest con testo in cui cercare vuoto.
If ldSostituisciStringa("", "PippO", "", True) <> "" Then
Err.Raise errldSostituisciStringaAutotest, _
"ldSostituisciStringa", _
"Errore nell'autotest (testo in cui cercare vuoto)"
End If
' Autotest con testo da cercare vuoto.
If ldSostituisciStringa("XXPipPoXXpiPPoPIPPOXXpippo", _
"", "Pluto", True) <> _
"XXPipPoXXpiPPoPIPPOXXpippo" Then
Err.Raise errldSostituisciStringaAutotest, _
"ldSostituisciStringa", _
"Errore nell'autotest (testo da cercare vuoto)"
End If
Exit Function
End If
' Controllo gli argomenti
If strTrova = "" Then
ldSostituisciStringa = strTesto
Exit Function
End If
' Per ottenere il case insensitive cerco tutto in minuscolo.
If fIgnoraMaiuscole Then
strTrova = LCase(strTrova)
End If
' Cerco la prima posizione da sostituire.
lngPivot = 0
' Eseguo tutte le sostituzioni.
Do While True
' Sincronizzo stringa di ricerca e testo da sostituire.
If fIgnoraMaiuscole Then
strRicerca = LCase(strTesto)
Else
strRicerca = strTesto
End If
' Cerco la prossima occorrenza.
lngPivot = InStr(lngPivot + 1, strRicerca, strTrova, vbBinaryCompare)
If lngPivot <= 0 Then
Exit Do
End If
' Recupero il testo prima dell'occorrenza.
strPrima = Left(strTesto, (lngPivot - 1))
' Recupero il testo dopo l'occorrenza.
strDopo = Mid(strTesto, lngPivot + Len(strTrova))
' Eseguo la sostituzione.
strTesto = strPrima & strSostituisci & strDopo
lngPivot = lngPivot + Len(strSostituisci) - 1
Loop
ldSostituisciStringa = strTesto
End Function
|