VBA, MS Access MS Access в примерах

Очистка текста от спецсимволов

Пример эксплуотации

Private Sub cmdClear_Click()
Dim i%, x%
    
    i = Len(Me!txtTestMemo)
    Debug.Print "Было: " & i & " символов."
    Me!txtTestMemo = ClearString(Me!txtTestMemo)
    
    x = Len(Me!txtTestMemo)
    Debug.Print "Стало:" & x & " символов."
    Debug.Print "Разница (удалено): " i - x & " символов."

End Sub



Функция:

Public Function ClearString(vVal As Variant) As Variant
'Очистка текста от спецсимволов (расширенный вариант)
'--------------------------------------------------------------------------
Dim i As Integer
Dim iAsc As Integer        ' ANCI код символа
Dim sMid As String * 1     ' выделенный символ
Dim siLen As Integer       ' длинна очищаемой строки
Dim strNew As String       ' Очищенная строка
'--------------------------------------------------------------------------
On Error GoTo ClearString_Err
    strNew = CStr(vVal)    ' перадаём строку локальной переменной
    siLen = Len(strNew)    ' считаем длинну строки
    For i = 1 To siLen     ' перебераем все символы строки по циклу
        sMid = Mid(strNew, i, 1)    ' получаем символ из строки
        iAsc = Asc(sMid)            ' преобразовываем полученный символ в ANCII код
        Select Case iAsc
            Case 0 To 8: sMid = ""
            Case 10, 9: sMid = ""       'табуляция и новая строка меняем на пробел.
            Case 13: sMid = " "         'Переводы каретки меняем на пробел (!!!)
            Case 12: sMid = ""          'Новая страница
            Case 14 To 31: sMid = ""
            Case 127: sMid = ""         ' del
        End Select
        ClearString = ClearString & sMid
    Next i
    
    'Если в тексте двойные пробелы:


ClearString_End:
    On Error Resume Next
    Err.Clear
    Exit Function
 
ClearString_Err:
    'MsgBox "Error: " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
        "in Function: ClearString in module: 00_Tests", vbCritical, "Error in Application"
    Err.Clear
    Resume ClearString_End
End Function

Назад ToTop
L.E. 16.08.2019
Рейтинг@Mail.ru