Конвертиране на число в словом с думи за VBA за Microsoft Excel. По подразбиране работи за левове в мъжки род, но може да се използва и за мярка в женски род (например метро единици) или среден род (например евро)

NumberToWords (Bulgarian)

'=====================================================================================================================
'
'   Конвертиране на число в словом с думи за VBA за Microsoft Excel
'   Copyright (c) 2012-2018 Unicontsoft (wqweto@gmail.com)
'
' ОПИСАНИЕ
'
'   По подразбиране конвертира левове (в мъжки род), но може да се използва и за мярка в женски род (например метро
'   единици) или среден род (например евро).
'
' ИНСТАЛАЦИЯ
'
'   Отворете https://gist.github.com/4118581 и натиснете бутон [Raw], за да видите само нужния код. Изберете
'   цялото съдържание с Ctrl+A и копирайте в системния буфер с Ctrl+C
'
'   Стартирайте VBA в Excel с Alt+F11, щракнете с десен бутон на мишката върху VBAProject и изберете
'   Insert->Module от менюто. Поставете копираното съдържание с Ctrl+V в Module1 и затворете редактора.
'
' ИЗПОЛЗВАНЕ
'
'   В клетката, в която желаете да пише сумата словом можете да използвате това:
'
'     = ToWords(123)
'
'   или да подадете стойност на друга клетка (обща стойност на документа) така
'
'     = ToWords(A1)
'
'   което ще превърне числото от A1 в словом в текущата клетка.
'
'   Максимална стойност на първи параметър dblValue e 999 квадрилиона.
'
'     = ToWords(167.42)                   ->   Сто шестдесет и седем лв. и 42 ст.
'     = ToWords(-12341235)                ->   Минус дванадесет милиона триста четиридесет и една хиляди двеста
'                                              тридесет и пет лв.
'     = ToWords(341.6, "МЕ|стотни", "FF") ->   Триста четиридесет и една МЕ и 60 стотни
'     = ToWords(1.03)                     ->   Един лев и 03 ст.
'
' PUBLIC DOMAIN NOTICE AND DISCLAIMER
'
'   The author has placed this work in the Public Domain, thereby relinquishing all copyrights. Everyone is free to
'   use, modify, republish, sell or give away this work without prior consent from anybody.
'
'   This work is provided on an “as is” basis, without warranty of any kind. Use at your own risk! Under no
'   circumstances shall the author(s) or contributor(s) be liable for damages resulting directly or indirectly from
'   the use or non-use of this work.
'
'=====================================================================================================================

Public Function ToWords(ByVal dblValue As Double, Optional Measure As Variant, Optional Gender As Variant, Optional NumScale As Variant) As String
    Dim vDigits         As Variant
    Dim vGenderDigits   As Variant
    Dim vValue          As Variant
    Dim lIdx            As Long
    Dim lDigit          As Long
    Dim sResult         As String
    
    '--- fix optional params default values
    If IsMissing(Gender) Then
        Gender = vbNullString
    End If
    If IsMissing(NumScale) Then
        NumScale = 2
    End If
    '--- init digits (incl. gender ones)
    vDigits = Split("нула едно две три четири пет шест седем осем девет")
    vGenderDigits = Split(Join(vDigits))
    Select Case Left$(Gender, 1)
    Case vbNullString, "M", ""
        vGenderDigits(1) = "един"
        vGenderDigits(2) = "два"
    Case "F"
        vGenderDigits(1) = "една"
    End Select
    '--- split input value on decimal point and pad w/ zeroes
    vValue = Mid$(Format$(0, "0.0"), 2, 1)
    vValue = Split(Format$(Abs(dblValue), "0." & String(NumScale, "0")), vValue)
    vValue(0) = Right$(String$(18, "0") & vValue(0), 18)
    '--- loop input digits from right to left
    For lIdx = 1 To Len(vValue(0))
        If lIdx <= 3 Then
            lDigit = Mid$(vValue(0), Len(vValue(0)) - lIdx + 1, 1)
        Else
            lDigit = Mid$(vValue(0), Len(vValue(0)) - lIdx - 1, 3)
            lIdx = lIdx + 2
        End If
        If lDigit <> 0 Then
            '--- separate by space (first time prepend "и" too)
            If LenB(sResult) <> 0 And (lIdx <> 2 Or lDigit <> 1) Then
                If InStr(sResult, " и ") = 0 Then
                    sResult = " и " & sResult
                Else
                    sResult = " " & sResult
                End If
            End If
            Select Case lIdx
            Case 1
                sResult = vGenderDigits(lDigit) & sResult
            Case 2
                If lDigit = 1 Then
                    '--- 11 to 19 special wordforms
                    If LenB(sResult) <> 0 Then
                        sResult = Replace(LTrim$(sResult), vGenderDigits(1), "еди")
                        sResult = Replace(sResult, vGenderDigits(2), "два") & "надесет"
                    Else
                        sResult = "десет"
                    End If
                Else
                    sResult = IIf(lDigit = 2, "два", vDigits(lDigit)) & "десет" & sResult
                End If
            Case 3
                '--- hundreds have special suffixes for 2 and 3
                Select Case lDigit
                Case 1
                    sResult = "сто" & sResult
                Case 2, 3
                    sResult = vDigits(lDigit) & "ста" & sResult
                Case Else
                    sResult = vDigits(lDigit) & "стотин" & sResult
                End Select
            Case 6
                '--- thousands are in feminine gender
                Select Case lDigit
                Case 1
                    sResult = "хиляда" & sResult
                Case Else
                    sResult = ToWords(lDigit, vbNullString, Gender:="F") & " хиляди" & sResult
                End Select
            Case 9, 12, 15
                '--- no special cases for bigger values
                sResult = ToWords(lDigit, vbNullString) & " " & Split("милион милиард трилион квадрилион")((lIdx - 9) \ 3) _
                    & IIf(lDigit <> 1, "а", vbNullString) & sResult
            End Select
        End If
    Next
    '--- handle zero and negative values
    If LenB(sResult) = 0 Then
        sResult = vDigits(0)
    End If
    If dblValue < 0 Then
        sResult = "минус " & sResult
    End If
    '--- apply measure (use Measure:=vbNullString for none)
    If IsMissing(Measure) Then
        Measure = IIf(Val(vValue(0)) = 1, "лев", "лв.") & "|ст."
        Gender = "MF"
    End If
    If LenB(Measure) <> 0 Then
        If Right$(sResult, Len(vDigits(0))) = vDigits(0) And Val(vValue(1)) <> 0 And InStr(Measure, "|") > 0 Then
            sResult = ToWords(IIf(dblValue < 0, -1, 1) * Val(vValue(1)), Split(Measure, "|")(1), Mid$(Gender, 2))
        Else
            sResult = sResult & " " & Split(Measure, "|")(0)
            If Val(vValue(1)) <> 0 Or InStr(Measure, "|") > 0 Then
                sResult = sResult & " и " & vValue(1)
            End If
            If InStr(Measure, "|") > 0 Then
                sResult = sResult & " " & Split(Measure, "|")(1)
            End If
            sResult = UCase$(Left$(sResult, 1)) & Mid$(sResult, 2)
        End If
    End If
    ToWords = sResult
End Function

Public Function ToAllWords(ByVal dblValue As Double) As String
    ToAllWords = ToWords(Int(dblValue), "лв.") & " и " & LCase$(ToWords(Round((dblValue - Int(dblValue)) * 100), "ст.", "F"))
End Function

@jassss: Оооопс, оправих го! Мерси за bug report-а

здравей, благодаря за кода.
имам обаче проблем, който не е пряко свързан с него, но поради това не мога да го ползвам. на ексел 2007, на английски, с регионални настройки на уиндоус7 на английски (UK), като paste-на кода във VBA кирилицата излиза като "?" знаци. какво трябва да променя, че да разпознае кирилицата. по принцип в ексел нямам проблем да пиша на кирилица.
Благодаря

Може ли да предложите подобна VBA програма за Word? Какво трябва да се промени, за да се използва?

Благодаря,
О. Николов

Здравей, кода е чудесен! Имаш ли код и за OpenOffice? Благодаря предварително!!!

Здравейте, сега виждам този прекрасен код, но когато се опитам да сейвам файла, при повторно отваряне не работи. Моля за малко помощ

@roko2002: Вижте дали настройка за защита от макроси в Excel е на Ниска или Средна стойност.

cheers,
</wqw>

Прекрасен макрос, но допуска една грешка, може ли да я оправите
когато числото е -0,25 връща като словом "нула лв и двадесет и пет ст." Коректно е "минус двадесет и пет ст." Възможно ли да го оправите.
Освен това ако е възможно, винаги когато са само стотинки 0,25 да връша "двадесет и пет ст." а не както сега "нула лв и двадесет и пет ст.".
Благодаря предварително!

Моля и за още нещо - възможно ли е да се направи първата буква да не е главна, и когато няма стотинки 36,00 да изписва само "тридесет и шест лв" а не както сега " Тридесет и шест лв и 0 ст."

@jantadjer Мерси за bug report-а. Пипнах функцията като единствено не съм махнал да връща първа главна буква в резултата. Това може да се оправи с =LOWER(ToWords(A1)) във формулата на клетката примерно.

В момента тестовете връщат това:

Debug.Assert ToWords(0) = "Нула лв. и 00 ст."
    Debug.Assert ToWords(0.01) = "Една ст."
    Debug.Assert ToWords(0.25) = "Двадесет и пет ст."
    Debug.Assert ToWords(-0.25) = "Минус двадесет и пет ст."
    Debug.Assert ToWords(-0.25, "лв.") = "Минус нула лв. и 25"
    Debug.Assert ToWords(35) = "Тридесет и пет лв. и 00 ст."
    Debug.Assert ToWords(167.42) = "Сто шестдесет и седем лв. и 42 ст."
    Debug.Assert ToWords(-12341235) = "Минус дванадесет милиона триста четиридесет и една хиляди двеста тридесет и пет лв. и 00 ст."
    Debug.Assert ToWords(341.6, "МЕ|стотни", "FF") = "Триста четиридесет и една МЕ и 60 стотни"
    Debug.Assert ToWords(0.01, "МЕ|стотни", "FF") = "Една стотни"

Има лек проблем в последния тест (мн. ч. на стотни), който не смятам да оправям.

cheers,
</wqw>

Здравейте и благодаря за кода :)
С много малка промяна го ползвам за vb.net и незнам само при мен ли е така

3125.00 : Три лв. хиляди сто двадесет и пет лв.
225.00 : Дваста двадесет и пет лв.

Благодаря предварително!

@rboyadzhiev: Нещо при портването се е забозило, защото при мене тези assert-и минават:

Debug.Assert ToWords(3125) = "Три хиляди сто двадесет и пет лв."
Debug.Assert ToWords(225) = "Двеста двадесет и пет лв."

Можеш да направиш fork и да качиш VB.Net версията в отделен gist да я погледна. Имай предвид че gist.github.com не праща email нотификация при нови коментари, освен ако не си настроиш външна услуга като https://giscus.co/ да ги наблюдава -- most recommended!

cheers,
</wqw>

https://gist.github.com/rboyadzhiev/cb3be7a574ffccb4dc2d
Готово.

@rboyadzhiev: Fixed here https://gist.github.com/wqweto/d7ca68a5fd0368c08158

Добавил съм и тестовете.

cheers,
</wqw>

Супер! Благодаря много :)

Казвам го за всички които смятат да използват тази функцията за валути .. Да не се чудят какво става и защо сметките не излизат. Просто трябва да се промени форматирането на числото да е с 2 цифри след десетичната запетая.

Хахахха ... Докато коментирам твоя код открих бъг в коментарите на github :D ...

Липсващата част от горното съобщение е:
Внимавайте с форматирането на подаваното число в случай, че функцията се изполва за валути - пример:
6806,292 изписва
Шест хиляди осемстотин и шест лв. и 292 ст.
292 ст. са 2,92 лв.
Желателно е да премахнете двата '##' от форматирането, за да не се получават такива проблеми.

@hristo-atanasov: Да, това е оставено нарочно за да може да се ползва с хилядни, но явно този use-case не е добре тестван.

Добавил съм опционален параметър NumScale който ще предпазва от грешни (не добре закръглени) входни данни. По този начин добре се решава случаят, в който искаме за мярка да подадем "МЕ|хилядни" -- просто подаваме NumScale:=3 за да форматира 2.5 като Две МЕ и 500 хилядни а не 50 хилядни както досега.

За левове и ст. функцията продължава да се ползва както до момента, подава се единствено стойността като първи параметър и екстрата вече е че автоматично закръглява до втория знак. Трябва да се има предвид, че Excel ползва "банкерско" закръгляване, не аритметично на каквото сме свикнали от училище.

cheers,
</wqw>

Здравейте и благодаря за кода!
Имам един малък проблем, работя с LibreOffice и при стартиране на макроса ми дава грешка ...NumScale As Long = 2)..., че вместо "=" очаква " ) ". Макроса работи като изтрия " = 2 ", обаче при извеждане на стотинките ми ги дава във екпоненциялен формат, напр. 56 ст. -> 5,6Е+97 ст. Проблем на Libre ли е или...?
Предварително благодаря!

@andyon123 Проблемът не е в LibreOffice per se. Просто този код не е писан за неговия макро език, така че трябва някой да го преработи за да тръгне.

Edit: Последната ревизия е тествана с OpenOffice и би трябвало да работи и под LibreOffice също. Ако има проблеми пишете тук.

Може ли да се изписва "един лев и 00 ст.", а не както е сега "един лев" . И това да е като опция в "кода"
или къде трябва да се промени в "кода" ако желая да се изписва по този начин.

Пробвайте последната версия, пипнал съм функцията винаги да слага 00 ст.

cheers,
</wqw>

Здравейте, има ли как и цифрите след десетичната запетая да се изписват словом

Здравейте,

Добавил съм втора едноредова функция ToAllWords която работи винаги за левове/стотинки и последните са словом също.

За да я ползвате трябва повторно да си инсталирате модула, както е описано в инструкцията.

Ако не Ви устройва мерките да са лв. и съответно ст. можете да пробвате сами да си ги смените в ToAllWords.

</wqw>

Може ли да го направиш да конвертира на английски.

@zarkomm: Не, в интернет е пълно с английски версии. Пробвай да потърсиш в google.

cheers,
</wqw>

Здравей, отдавна си мислих по проблема и добре, че жена ми ме светна за да се разровя в нета ;-))) Пробвах кода ти и работи чудесно за което искам и да ти благодаря! Само един въпрос. Защото гледам, че е имало допълнения и редакции на бъгове, този като последен вариант ли е? Страхотна работа и благодаря отново!

@BBPopov: Да, текущия код винаги е последната ревизия.

Най-горе има таб Revisions с 22 до него -- там са предишните версии ако нещо те интересува.

cheers,
</wqw>

Благодаря! From: Vladimir Vissoultchev [mailto:notifications@github.com] Sent: Friday, May 31, 2019 11:19 PM To: wqweto Cc: BBPopov; Mention Subject: Re: wqweto/NumberToWords (Bulgarian) @BBPopov <https://github.com/BBPopov> : Да, текущия код винаги е последната ревизия. Най-горе има таб Revisions с 22 до него -- там са предишните версии ако нещо те интересува. cheers, </wqw> — You are receiving this because you were mentioned. Reply to this email directly, view it on GitHub <https://gist.github.com/4118581?email_source=notifications&email_token=AMG6O2WBXKK2KSO5B5KKXALPYGB3PA5CNFSM4HR4QV62YY3PNVWWK3TUL52HS4DFVNDWS43UINXW23LFNZ2KUY3PNVWWK3TUL5UWJTQAFS6PG#gistcomment-2931955> , or mute the thread <https://github.com/notifications/unsubscribe-auth/AMG6O2T6CHPN7C6GPJCEAQTPYGB3PANCNFSM4HR4QV6Q> . <https://github.com/notifications/beacon/AMG6O2RJ6NIBQYG7QVRE3JTPYGB3PA5CNFSM4HR4QV62YY3PNVWWK3TUL52HS4DFVNDWS43UINXW23LFNZ2KUY3PNVWWK3TUL5UWJTQAFS6PG.gif>

Вариант на функцията с unicode кодирана кирилица за тези на които им излизат въпросителни:

Public Function ToWords(ByVal dblValue As Double, Optional Measure As Variant, Optional Gender As Variant, Optional NumScale As Variant) As String
    Dim vDigits         As Variant
    Dim vGenderDigits   As Variant
    Dim vValue          As Variant
    Dim lIdx            As Long
    Dim lDigit          As Long
    Dim sResult         As String
    
    '--- fix optional params default values
    If IsMissing(Gender) Then
        Gender = vbNullString
    End If
    If IsMissing(NumScale) Then
        NumScale = 2
    End If
    '--- init digits (incl. gender ones)
    vDigits = Split(ChrW(&H43D)&ChrW(&H443)&ChrW(&H43B)&ChrW(&H430)&ChrW(&H20)&ChrW(&H435)&ChrW(&H434)&ChrW(&H43D)&ChrW(&H43E)&ChrW(&H20)&ChrW(&H434)&ChrW(&H432)&ChrW(&H435)&ChrW(&H20)&ChrW(&H442)&ChrW(&H440)&ChrW(&H438)&ChrW(&H20)&ChrW(&H447)&ChrW(&H435)&ChrW(&H442)&ChrW(&H438)&ChrW(&H440)&ChrW(&H438)&ChrW(&H20)&ChrW(&H43F)&ChrW(&H435)&ChrW(&H442)&ChrW(&H20)&ChrW(&H448)&ChrW(&H435)&ChrW(&H441)&ChrW(&H442)&ChrW(&H20)&ChrW(&H441)&ChrW(&H435)&ChrW(&H434)&ChrW(&H435)&ChrW(&H43C)&ChrW(&H20)&ChrW(&H43E)&ChrW(&H441)&ChrW(&H435)&ChrW(&H43C)&ChrW(&H20)&ChrW(&H434)&ChrW(&H435)&ChrW(&H432)&ChrW(&H435)&ChrW(&H442))
    vGenderDigits = Split(Join(vDigits))
    Select Case Left$(Gender, 1)
    Case vbNullString, ChrW(&H4D), ""
        vGenderDigits(1) = ChrW(&H435)&ChrW(&H434)&ChrW(&H438)&ChrW(&H43D)
        vGenderDigits(2) = ChrW(&H434)&ChrW(&H432)&ChrW(&H430)
    Case ChrW(&H46)
        vGenderDigits(1) = ChrW(&H435)&ChrW(&H434)&ChrW(&H43D)&ChrW(&H430)
    End Select
    '--- split input value on decimal point and pad w/ zeroes
    vValue = Mid$(Format$(0, ChrW(&H30)&ChrW(&H2E)&ChrW(&H30)), 2, 1)
    vValue = Split(Format$(Abs(dblValue), ChrW(&H30)&ChrW(&H2E) & String(NumScale, ChrW(&H30))), vValue)
    vValue(0) = Right$(String$(18, ChrW(&H30)) & vValue(0), 18)
    '--- loop input digits from right to left
    For lIdx = 1 To Len(vValue(0))
        If lIdx <= 3 Then
            lDigit = Mid$(vValue(0), Len(vValue(0)) - lIdx + 1, 1)
        Else
            lDigit = Mid$(vValue(0), Len(vValue(0)) - lIdx - 1, 3)
            lIdx = lIdx + 2
        End If
        If lDigit <> 0 Then
            '--- separate by space (first time prepend ChrW(&H438) too)
            If LenB(sResult) <> 0 And (lIdx <> 2 Or lDigit <> 1) Then
                If InStr(sResult, ChrW(&H20)&ChrW(&H438)&ChrW(&H20)) = 0 Then
                    sResult = ChrW(&H20)&ChrW(&H438)&ChrW(&H20) & sResult
                Else
                    sResult = ChrW(&H20) & sResult
                End If
            End If
            Select Case lIdx
            Case 1
                sResult = vGenderDigits(lDigit) & sResult
            Case 2
                If lDigit = 1 Then
                    '--- 11 to 19 special wordforms
                    If LenB(sResult) <> 0 Then
                        sResult = Replace(LTrim$(sResult), vGenderDigits(1), ChrW(&H435)&ChrW(&H434)&ChrW(&H438))
                        sResult = Replace(sResult, vGenderDigits(2), ChrW(&H434)&ChrW(&H432)&ChrW(&H430)) & ChrW(&H43D)&ChrW(&H430)&ChrW(&H434)&ChrW(&H435)&ChrW(&H441)&ChrW(&H435)&ChrW(&H442)
                    Else
                        sResult = ChrW(&H434)&ChrW(&H435)&ChrW(&H441)&ChrW(&H435)&ChrW(&H442)
                    End If
                Else
                    sResult = IIf(lDigit = 2, ChrW(&H434)&ChrW(&H432)&ChrW(&H430), vDigits(lDigit)) & ChrW(&H434)&ChrW(&H435)&ChrW(&H441)&ChrW(&H435)&ChrW(&H442) & sResult
                End If
            Case 3
                '--- hundreds have special suffixes for 2 and 3
                Select Case lDigit
                Case 1
                    sResult = ChrW(&H441)&ChrW(&H442)&ChrW(&H43E) & sResult
                Case 2, 3
                    sResult = vDigits(lDigit) & ChrW(&H441)&ChrW(&H442)&ChrW(&H430) & sResult
                Case Else
                    sResult = vDigits(lDigit) & ChrW(&H441)&ChrW(&H442)&ChrW(&H43E)&ChrW(&H442)&ChrW(&H438)&ChrW(&H43D) & sResult
                End Select
            Case 6
                '--- thousands are in feminine gender
                Select Case lDigit
                Case 1
                    sResult = ChrW(&H445)&ChrW(&H438)&ChrW(&H43B)&ChrW(&H44F)&ChrW(&H434)&ChrW(&H430) & sResult
                Case Else
                    sResult = ToWords(lDigit, vbNullString, Gender:=ChrW(&H46)) & ChrW(&H20)&ChrW(&H445)&ChrW(&H438)&ChrW(&H43B)&ChrW(&H44F)&ChrW(&H434)&ChrW(&H438) & sResult
                End Select
            Case 9, 12, 15
                '--- no special cases for bigger values
                sResult = ToWords(lDigit, vbNullString) & ChrW(&H20) & Split(ChrW(&H43C)&ChrW(&H438)&ChrW(&H43B)&ChrW(&H438)&ChrW(&H43E)&ChrW(&H43D)&ChrW(&H20)&ChrW(&H43C)&ChrW(&H438)&ChrW(&H43B)&ChrW(&H438)&ChrW(&H430)&ChrW(&H440)&ChrW(&H434)&ChrW(&H20)&ChrW(&H442)&ChrW(&H440)&ChrW(&H438)&ChrW(&H43B)&ChrW(&H438)&ChrW(&H43E)&ChrW(&H43D)&ChrW(&H20)&ChrW(&H43A)&ChrW(&H432)&ChrW(&H430)&ChrW(&H434)&ChrW(&H440)&ChrW(&H438)&ChrW(&H43B)&ChrW(&H438)&ChrW(&H43E)&ChrW(&H43D))((lIdx - 9) \ 3) _
                    & IIf(lDigit <> 1, ChrW(&H430), vbNullString) & sResult
            End Select
        End If
    Next
    '--- handle zero and negative values
    If LenB(sResult) = 0 Then
        sResult = vDigits(0)
    End If
    If dblValue < 0 Then
        sResult = ChrW(&H43C)&ChrW(&H438)&ChrW(&H43D)&ChrW(&H443)&ChrW(&H441)&ChrW(&H20) & sResult
    End If
    '--- apply measure (use Measure:=vbNullString for none)
    If IsMissing(Measure) Then
        Measure = IIf(Val(vValue(0)) = 1, ChrW(&H43B)&ChrW(&H435)&ChrW(&H432), ChrW(&H43B)&ChrW(&H432)&ChrW(&H2E)) & ChrW(&H7C)&ChrW(&H441)&ChrW(&H442)&ChrW(&H2E)
        Gender = ChrW(&H4D)&ChrW(&H46)
    End If
    If LenB(Measure) <> 0 Then
        If Right$(sResult, Len(vDigits(0))) = vDigits(0) And Val(vValue(1)) <> 0 And InStr(Measure, ChrW(&H7C)) > 0 Then
            sResult = ToWords(IIf(dblValue < 0, -1, 1) * Val(vValue(1)), Split(Measure, ChrW(&H7C))(1), Mid$(Gender, 2))
        Else
            sResult = sResult & ChrW(&H20) & Split(Measure, ChrW(&H7C))(0)
            If Val(vValue(1)) <> 0 Or InStr(Measure, ChrW(&H7C)) > 0 Then
                sResult = sResult & ChrW(&H20)&ChrW(&H438)&ChrW(&H20) & vValue(1)
            End If
            If InStr(Measure, ChrW(&H7C)) > 0 Then
                sResult = sResult & ChrW(&H20) & Split(Measure, ChrW(&H7C))(1)
            End If
            sResult = UCase$(Left$(sResult, 1)) & Mid$(sResult, 2)
        End If
    End If
    ToWords = sResult
End Function

Public Function ToAllWords(ByVal dblValue As Double) As String
    ToAllWords = ToWords(Int(dblValue), ChrW(&H43B)&ChrW(&H432)&ChrW(&H2E)) & ChrW(&H20)&ChrW(&H438)&ChrW(&H20) & LCase$(ToWords(Round((dblValue - Int(dblValue)) * 100), ChrW(&H441)&ChrW(&H442)&ChrW(&H2E), ChrW(&H46)))
End Function

@staafl: LGTM във VBA работи.

Това за OpenOffice ли е полезно или по принцип и за VBA?

На последния мисля модулите му са Unicode и не би трябвало да има проблем с нормалните string литерали.

cheers,
</wqw>