Словесное представление чисел

 Private Function propis(numb As Long) As String
Select Case numb
Case 23
propis = "двадцать три"
Case 7
propis = "семь"
End Select
 End Function
  
 Private Sub Form_Load()
 Dim arrMyArray() As String
  Dim strMyString As String
  strMyString = "я купил хлеб за 23 рубля, сдача составляет 7 рублей"
  arrMyArray = Split(strMyString)
  
  For i = 0 To UBound(arrMyArray)
    If Val(arrMyArray(i)) Then
    arrMyArray(i) = propis(Val(arrMyArray(i)))
  End If
  strMyString = ""
  Next
   For i = 0 To UBound(arrMyArray)
   strMyString = strMyString & " " & arrMyArray(i)
  Next
  MsgBox strMyString
End Sub

Option Explicit
 
Private Sub Command1_Click()
    Dim SS, S As String, i As Integer
    S = InputBox("Ввод", "Ввод", "я купил хлеб за 23 рубля, сдача составляет 7 рублей")
    SS = Split(S)
    For i = 0 To UBound(SS)
        If IsNumeric(SS(i)) Then SS(i) = num2text_word(CLng(SS(i)))
    Next i
    MsgBox Join(SS)
End Sub
 
Function num2text_word(x As Long, Optional Lang As Long = 1049) As String
    With CreateObject("word.document")
       .Range.LanguageID = Lang
       .Fields.Add .Range, Type:=-1, Text:="=" & x & " \* cardtext"
        num2text_word = Replace(.Range.Text, vbCr, "")
       .Close 0
    End With
End Function

'
'       Число прописью
'       © JoraVoenyjHaker
'
Const s0 = "ноль"
Const s1 = "один два три четыре пять шесть семь восемь девять"
Const s2 = "одинадцать двенадцать тринадцать четырнадцать пятнадцать шестнадцать семнадцать восемнадцать девятнадцать"
Const s3 = "десять двадцать тридцать сорок пятьдесят шестьдесят семьдесят восемьдесят девяносто"
Const s4 = "сто двести триста четыреста пятьсот шестьсот семьсот восемьсот девятьсот"
Const s5 = "тысяча-тысячи-тысяч/" & _
"миллион/миллиард/триллион/" & _
"квадриллион/квинтиллион/секстиллион/" & _
"септиллион/октиллион/нониллион/" & _
"дециллион/андециллион/дуодециллион/" & _
"тредециллион/кваттордециллион/квиндециллион/" & _
"сексдециллион/септемдециллион/октодециллион" 'Наверное хватит )))
 Enum f_UpNu
    [Начало с заглавной буквы] = 1
    [Расставить запятые] = 2
 End Enum
 
Public Function UppercaseNumber$(ByVal Num$, Optional flag As f_UpNu, Optional Rekurs&)
    'Возвращаемое значение предложение словами от -10^60+1  до 10^60-1
    'Арг: Число текстом "1234..." без других знаков // Комбинируемый флаг // Текущая рекурсия
    Const r$ = "/", r1 = "-", pr$ = " "
    Dim l#, l1#, l2#, key1$, key2$, key3$, j$(), f&
    Dim Sborka$
    
    If Rekurs = 0 Then
        Num = Replace(Num, pr, "") 'Удалить возможные пробелы
        If Num = 0 Then
            UppercaseNumber = s0: Exit Function
        ElseIf Num < 0 Then
            Num = Mid(Num, 2)
            Sborka = "минус "
        End If
    End If
    key1 = Num
    Do
        l = Len(key1)
        Select Case l
        Case 1
            l1 = Mid(key1, 1, 1)
            If l1 > 0 Then Sborka = Sborka & Split(s1)(l1 - 1) & pr
            key1 = Mid(key1, 2)
        Case 2
            If key1 > 10 And key1 < 20 Then
                l1 = Mid(key1, 2, 1)
                Sborka = Sborka & Split(s2)(l1 - 1) & pr
                key1 = Mid(key1, 3)
            Else
                l1 = Mid(key1, 1, 1)
                If l1 > 0 Then Sborka = Sborka & Split(s3)(l1 - 1) & pr
                key1 = Mid(key1, 2)
            End If
        Case 3
            l1 = Mid(key1, 1, 1)
            If l1 > 0 Then Sborka = Sborka & Split(s4)(l1 - 1) & pr
            key1 = Mid(key1, 2)
        Case Is > 3
            Do
                l1 = l Mod 3
                If l1 Then
                    key2 = Mid(key1, 1, l1): key1 = Mid(key1, l1 + 1)
                Else: key2 = Mid(key1, 1, 3): key1 = Mid(key1, 4)
                End If
                key3 = UppercaseNumber(key2, flag, Rekurs + 1)
                l = Len(key1): l2 = Fix(l / 3) - 1
                
                If key3 <> s0 Then
                    Sborka = Sborka & key3
                    If Right$(key2, 2) > 10 And Right$(key2, 2) < 20 Then key2 = 0
                    If l2 = 0 Then
                        j = Split(Split(s5, r)(l2), r1)
                        Select Case key2 Mod 10
                        Case 1: Sborka = Sborka & j(0) & pr
                        Case 2, 3, 4: Sborka = Sborka & j(1) & pr
                        Case Else: Sborka = Sborka & j(2) & pr
                        End Select
                        Sborka = Replace(Sborka, "один тысяча", "одна тысяча")
                        Sborka = Replace(Sborka, "два тысячи", "две тысячи")
                    Else
                        j = Split("0 а ов")
                        j(0) = Split(s5, r)(l2)
                        Select Case key2 Mod 10
                        Case 1: Sborka = Sborka & j(0) & pr
                        Case 2, 3, 4: Sborka = Sborka & j(0) & j(1) & pr
                        Case Else: Sborka = Sborka & j(0) & j(2) & pr
                        End Select
                    End If
                    If flag >= [Расставить запятые] Then Sborka = RTrim(Sborka) & ", "
                End If
            Loop While l > 3
        End Select
    Loop While l
    
    If Rekurs = 0 Then
        Num = flag Mod 4
        While Num
            Select Case Num
            Case Is >= [Расставить запятые]
                Num = Num - [Расставить запятые]
            Case Is >= [Начало с заглавной буквы]
                Num = Num - [Начало с заглавной буквы]
                Mid(Sborka, 1, 1) = UCase(Mid(Sborka, 1, 1))
            End Select
        Wend
    End If
    UppercaseNumber = Sborka
End Function
 
 
 Private Sub Form_Load()
 Dim arrMyArray() As String
  Dim strMyString As String
  strMyString = "я купил хлеб за 24 рубля, сдача составляет 9 рублей"
  arrMyArray = Split(strMyString)
  
  For i = 0 To UBound(arrMyArray)
    If Val(arrMyArray(i)) Then
    arrMyArray(i) = UppercaseNumber$(Val(arrMyArray(i))) '
  End If
  strMyString = ""
  Next
   For i = 0 To UBound(arrMyArray)
   strMyString = strMyString & " " & arrMyArray(i)
  Next
  MsgBox strMyString
End Sub

Optional flag As Integer