Проблемы со скриптом СуммаПропись

[Shavminator]

Добрый день

Есть макрос перевода сумму в пропись на таджикском языке, скопированный из модулей FoxPro. Как сделать из нее функцию в VBA и использовать в Excel-е?

Заранее благодарю

вот код скопированный с FoxPro

*********************************** *********
* PROPISTJ
*********************************** *********
* переменные, которые должны быть
* в вызывающей программе
*********************************** *********
* sum1 - вход - сумма (числовая) выход (сумма в письменом виде)
* valut1 - наименование валюты ("СОМОНИ" "ДОЛЛАР"...)
* valut2 - наименование десятичн ("ДИРАМ" "ЦЕНТ"...)
*********************************** *********
PARAMETERS sum1, valut1, valut2
LOCAL sum, singl, dec1, dec2, handr, kop,;
mlr, mln, sou, han, a1, a2, a3, i, al

al = ALIAS(SELECT())

SELECT 0

IF (sum1 > 999999999999.99)
RETURN
ENDIF

sum = sum1
DIMENSION eddec1(19), dec2(10), handr(10), zzz(4), s4(4)

eddec1(1) = " ЯК"
eddec1(2) = " ДУ"
eddec1(3) = " СЕ"
eddec1(4) = " ЧОР"
eddec1(5) = " ПАНЧ"
eddec1(6) = " ШАШ"
eddec1(7) = " ХАФТ"
eddec1(8) = " ХАШТ"
eddec1(9) = " НУХ"
eddec1(10) = " ДАХ"
eddec1(11) = " ЁЗДАХ"
eddec1(12) = " ДВОЗДАХ"
eddec1(13) = " СЕНЗДАХ"
eddec1(14) = " ЧОРДАХ"
eddec1(15) = " ПОНЗДАХ"
eddec1(16) = " ШОНЗДАХ"
eddec1(17) = " ХАБДАХ"
eddec1(18) = " ХАЖДАХ"
eddec1(19) = " НУЗДАХ"

dec2(2) = " БИСТ"
dec2(3) = " СИ"
dec2(4) = " ЧИЛ"
dec2(5) = " ПАНЧОХ"
dec2(6) = " ШАСТ"
dec2(7) = " ХАФТОД"
dec2(8) = " ХАШТОД"
dec2(9) = " НАВАД"

zzz(1) = " МИЛЛИАРД"
zzz(2) = " МИЛЛИОН"
zzz(3) = " ХАЗОР"
zzz(4) = " САД"

kop = RIGHT(STR(sum - INT(sum),3,2),2)
sum = STR(INT(sum),12)

s4(1) = SUBSTR(sum,1,3) && миллиарды
s4(2) = SUBSTR(sum,4,3) && миллионы
s4(3) = SUBSTR(sum,7,3) && тысячи
s4(4) = SUBSTR(sum,10,3) && сотни

FOR i=1 TO 4

IF VAL(s4(i)) # 0
IF (VAL(s4(i)) > 0)
a1 = VAL(SUBSTR(s4(i),1,1))
a2 = VAL(SUBSTR(s4(i),2,1))
a3 = VAL(SUBSTR(s4(i),3,1))

IF (a2 > 0) OR (a3 > 0)

DO CASE
CASE (a2 = 1) && 1 - 19
s4(i) = eddec1(VAL(ALLTRIM(STR(a2)) + ALLTRIM(STR(a3))))
CASE (a2 > 1) AND (a3 > 0) && 21 32 47 ...
s4(i) = dec2(a2) + IIF(a2 = 3, "Ю", "У") + eddec1(a3)
CASE (a2 > 1) AND (a3 = 0) && 20 30 40 ...
s4(i) = dec2(a2)
CASE (a2 = 0)
s4(i) = eddec1(a3) && 1 - 9
ENDCASE
ELSE
s4(i) = ""
ENDIF

IF (a1 > 0)
s4(i) = IIF(a2#0 OR a3#0, eddec1(a1) + ALLTRIM(zzz(4)) + "У", IIF(a1#1, eddec1(a1) + ALLTRIM(zzz(4)), zzz(4))) + s4(i)
ENDIF

IF (i < 4)
s4(i) = s4(i) + zzz(i)
ENDIF

ELSE
s4(i) = ""
ENDIF
ELSE
s4(i) = ""
ENDIF

ENDFOR

SUM = ""
IF !EMPTY(s4(1))
SUM = SUM +" "+ ALLTRIM( s4(1) + IIF(!EMPTY(s4(2)), "У", ""))
ENDIF
IF !EMPTY(s4(2))
SUM = SUM +" "+ ALLTRIM( s4(2) + IIF(!EMPTY(s4(3)), "У", ""))
ENDIF
IF !EMPTY(s4(3))
SUM = SUM +" "+ ALLTRIM( s4(3) + IIF(!EMPTY(s4(4)), "У", ""))
ENDIF
SUM = ALLTRIM(SUM + s4(4) +' '+ valut1 +' '+ kop +' '+ valut2 )
SUM = UPPER(LEFT(SUM, 1)) + LOWER(SUBSTR(SUM, 2))
sum1 = SUM
RETURN

[Hugo121]

Всё уже написано:
http://www.excelworld.ru/forum/2-828-2

[Shavminator]

Спасибо большое, работает!

[Shavminator]

А как сделать так чтоб скрипт из этого файла срабатывал не только на этом файле, но и на любом файле Екселе в моем компьютере?

Я сохранил этот файл как Надстройку, добавил эту надстройку в список надстройках, вот что-то не срабатывает.

[Hugo121]

Должно работать, как и любая другая UDF из надстройки или personal.xls*

[IgorGO]

Shavminator, на каком это языке числительные подскажите?

[Watcher_1]

Сообщение от IgorGO

Shavminator, на каком это языке числительные подскажите?

На Таджикском