www.eliteclub.h10.ru - Приглашаем в совместный бизнес!

___________________________________________________________________________________________________________

Добрый день!

Хочу предложить вашему вниманию переписку с одним из корреспондентов. К сожалению, я не смог ему помочь. Может быть получится у вас?

Здравствуйте Александр

В одной из рассылок по EXCEL Вы говорили об надстройках позволяющих автоматизировать написание в платежных документах цифр прописью. Последовав указанной ссылке обнаружил массу надстроек. Однако та которая была мне интересной Propis99 (возможность написания цифр на украинском языке) не хочет работает. Хотя другие надстройки работают. При обращении к данной надстройке появляется сообщение:" Object library not registered" нажав на ОК появляется сообщение.
Что странно при одинаковых настройках системы одни надстройки работают эта не хочет. Подскажите как выйти из данной ситуации.

А вы пробовали установить файл Propis99.xla по указанному адресу?
Иногда это нужно делать вручную. Адрес указан в появляющемся у вас
окне - C:\Program Files\Microsoft Office\Office11\Library. 

 Именно по этому адресу и находится надстройка. Что 
 удивительно другие надстройки работают эта нет.

 Добрый день, Юрий!
 Вообщем-то все установилась и работает.
 У меня ситуация следующая - системным является диск G и,
 соответственно, файл установлен по адресу не диска С, а диска G. И еще
- нужен именно файл Propis99.xla из архива, а не сам архив. После этого находим нужную 
надстройку - Сервис-Надстройки-Обзор, указываем на файл Propis99.xla.
 Затем в меню Вставка находим Функции-Определенные
 пользователем-ПрописГрн. И все работает, т.е. показывает прописью
нужную сумму. 
Можно сделать следующее - удалить имеющиеся надстройки прописей и
установить эту "с нуля". Хотя я ничего не удалял.

Здравствуйте
Все делал как Вы написали однако результат не изменился.
Любая другая надстройка работает эта НЕТ.
Как пишутся надстройки? Нашел несколько исходников можно было бы попробовать. 

К сожалению, как пишутся надстройки, я не знаю и в этом случае помочь 
ничем не могу. Единственное что могу предложить - разместить нашу
"беседу" в рассылке и может быть кто подскажет решение проблемы. Вы не
против?

Здравствуйте Александр

 Попробую расписать все по порядку:

1. Есть проблема - Необходима надстройка для EXCEL переводящая цифры в пропись. (Что бывает необходимым для заполнения различных финансовых документов и других бланков с графой сумма прописью).

2. В результате поисков готовых продуктов в Интернете было обнаружено большое количество надстроек макросов и других программ решающих эту задачу. Однако только одна из них отвечала необходимым требованиям - позволяла выбирать не только вид валюты, но и язык написания суммы прописью.  

3. Казалось, что проблема решена. Однако возникла новая. Найденная надстройка не работает. EXCEL ее видит. Она появляется в списке доступных надстроек, но при выборе выдается ошибка: " Object library not registered" дальнейшее нажатие на ОК выводит на экран сообщение "Нет доступа к файлу..."

4. Что странно другие найденные надстройки работают без проблем, да и данная на других компьютерах тоже работает.

5. Дальнейшие поиски путей решения проблемы привили на сайт Microsoft, где был обнаружен исходный текст, который может послужить основанием для написания надстройки.

6. Возникла третья проблема на каком языке и по каким правилам пишутся надстройки для EXCEL. Файл должен иметь расширение *.xla .

7. Подводя итог выше сказанному, вижу следующие пути решения проблемы:

а) консультация специалиста по поводу найденной надстройки, которая позволит ее использовать;

б) написание новой надстройки.

8. Идя по первому пути, были размещены просьбы на форумах программистов (к сожалению пока советов не последовало).

9. Второй путь возможен только с Вашей помощью Александр.

Объявить конкурс среди подписчиков рассылки, призом которой станет возвеличивание имени создателя в очередной статье.

10. Цель конкурса написание надстройки (*.xla) для EXCELпозволяющей переводить цифры в письменную форму, менять единицы измерения, менять название валюты, менять название дробной части (копейки, центы), менять язык написания цифр прописью (русский, украинский, английский), писать цифры с учетом падежей. Программа должна быть написана ОБЯЗАТЕЛЬНО на основе текста размещенного на сайте Microsoft, как оптимального для решения данной задачи

Вроде ничего не перепутал.

Удачи Вам Александр.

Что ж, за пожелание удачи - спасибо. 

Итак, конкурс объявлен, его условия ясны и понятны - ВПЕРЕД!

Вот текст, размещенный на сайте Microsoft:

Задача автоматического представления числового значения прописью является одной из наиболее часто встречающихся при составлении юридических документов. При этом речь может идти не только о денежных суммах, но и о количестве каких-либо товаров.

Кстати, многие из первых макросов, присланных для конкурса Microsoft еще в 1997 году, решали именно эту задачу и некоторые из них получили призы. Но предлагаемые там решения имеют уже «встроенный» характер, к тому же, на наш взгляд, не очень универсальны и оптимальны. Исходный код у многих таких расширений закрыт, а у тех, где открыт, требует, честно говоря, слишком больших усилий, чтобы в них разобраться.

Поэтому мы решили предложить читателям собственный вариант.

В листинге в конце страницы находится процедура SummaString, которая в свою очередь использует внутреннюю служебную подпрограмму SummaStringThree. Там же имеется описание входных и выходных параметров. Эта процедура учитывает правильное склонение числительных в зависимости от рода единицы измерения (мужской, женский, средний) и ее практическое применение может выглядеть следующим образом:

Листинг 1.

Source& = 2000011

CALL SummaString(Summa$, Source&, 1, "рубль", "рубля", "рублей")

Print Summa$ ' два миллиона одиннадцать рублей

'

Source& = 22

CALL SummaString(Summa$, Source&, 2, "копейка", "копейки", "копеек")

Print Summa$ ' двадцать две копейки

'

Source& = 1231

Call SummaString(Summa$, Source&, 3, "колесо", "колеса", "колес")

Print Summa$ ' одна тысяча двести тридцать одно колесо

'

Call SummaString(Summa$, Source&, 1, "", "", "")

Print Summa$ ' одна тысяча двести тридцать один

Print Summa$ + " руб." ' одна тысяча двести тридцать один руб.

Еще несколько дополнительных замечаний:

Для хранения исходного числа используется переменная типа Long, что позволяется работать с числами до 2147483647 (2^31—1).

Если нужно увеличить диапазон, то следует просто заменить тип переменных Source и TempValue на Double или Currency, а также добавить в SummaString код для учета триллионов и т. д. (см. листинг).

Обратите внимание, что процедуры SummaString и SummaStringThree не используют каких-либо экзотических программных конструкций — они могут работать с любыми версиями VB, VBA и Basic/DOS.

По правилам оформления бухгалтерских документов сумма прописью должна обязательно начинаться с прописной буквы. Для такого преобразования можно использовать функцию StrConv, но при этом нужно помнить, что ее корректная работа с национальными алфавитами в VB до версии 5.0 включительно обеспечивается только

при установке в системе соответствующей кодовой таблицы.

Чтобы выполнить нужное преобразование независимо от версии VB и системных установок Windows, гораздо проще применить следующую конструкцию:

Листинг 2.

Mid$(Summa$, 1) = Chr$(Asc(Summa$) - 32)

Для DOS-овских версий, в которых преобразование регистра выполняется только для английских букв, такая операция будет выглядеть немного сложнее (альтернативная русская таблица DOS — cp866):

Листинг 3.

s% = ASC(Summa$)

IF s% <= 175 THEN s% = s% - 32 ELSE s% = s% = 80

MID$(Summa$, 1) = CHR$(s%)

Здесь мы воспользовались тем обстоятельством, что полученная символьная строка гарантированно (так работает наш алгоритм) начинается со строчной русской буквы. В противном случае пришлось бы сделать небольшую проверку на попадание ASCII-кода

в нужный диапазон.

Листинг 4.

Функция SummaString выполняет задачу «запись числи прописью»

Sub SummaString(Summa$, Source As Long, Rod%, w1$, w2to4$, w5to10$)

'

' "Сумма прописью":

'  преобразование числа из цифрового вида в символьное

' ==================================================

' Исходные данные:

'  Source - число от 0 до 2147483647 (2^31-1)

   ' Eсли нужно оперировать с числами > 2 147 483 647

   ' замените описание переменных Source и TempValue на "AS DOUBLE"

'

'    далее нужно задать информацию о единице изменения

'  Rod%   = 1 - мужской, = 2 - женский, = 3 - средний

'     название единицы изменения:

'  w1$     - именительный падеж единственное число (= 1)

'  w2to4$  - родительный падеж единственное число (= 2-4)

'  w5to10$ - родительный падеж множественное число ( = 5-10)

'

'  Rod% должен быть задано обязательно, название единицы может быть

'       не задано = ""

' ———————————————-

' Результат: Summa$ - запись прописью

'

'================================

   Dim TempValue As Long

   '

   If Source& = 0 Then

     Summa$ = RTrim$("ноль " + w5to10$): Exit Sub

   End If

   '

   TempValue = Source: Summa$ = ""

   ' единицы

   Call SummaStringThree(Summa$, TempValue, Rod%, w1$, w2to4$, w5to10$)

   If TempValue = 0 Then Exit Sub

   ' тысячи

   Call SummaStringThree(Summa$, TempValue, 2, "тысяча", "тысячи", "тысяч")

   If TempValue = 0 Then Exit Sub

   ' миллионы

   Call SummaStringThree(Summa$, TempValue, 1, "миллион",

"миллиона", "миллионов")

   If TempValue = 0 Then Exit Sub

   ' миллиардов

   Call SummaStringThree(Summa$, TempValue, 1, "миллиард",

"миллиарда", "миллиардов")

   If TempValue = 0 Then Exit Sub

   '

   ' Eсли нужно оперировать с числами > 2 147 483 647

   ' измените тип переменных (см. выше) и добавьте эту строку для триллионов:

   ' CALL SummaStringThree(Summa$, TempValue#, 1, "трилллион",

"триллиона", "триллионов")

   ' IF TempValue# = 0 THEN EXIT SUB

   '

   ' Что идет после триллионов, я плохо представляю...

   '

End Sub

Sub SummaStringThree(Summa$, TempValue As Long, Rod%, w1$, w2to4$, w5to10$)

'

'  Формирования строки для трехзначного числа:

'  (последний трех знаков TempValue

   ' Eсли нужно оперировать с числами > 2 147 483 647

   ' замените в описании на  TempValue AS DOUBLE

'====================================

   Dim Rest%, Rest1%, EndWord$, s1$, s10$, s100$

   '

   Rest% = TempValue& Mod 1000

   TempValue& = TempValue& \ 1000

   If Rest% = 0 Then    ' последние три знака нулевые

     If Summa$ = "" Then Summa$ = w5to10$ + " "

     Exit Sub

   End If  

   '

   ' начинаем подсчет с Rest

   EndWord$ = w5to10$

   ' сотни

   Select Case Rest% \ 100

     Case 0: s100$ = ""

     Case 1: s100$ = "сто "

     Case 2: s100$ = "двести "

     Case 3: s100$ = "триста "

     Case 4: s100$ = "четыреста "

     Case 5: s100$ = "пятьсот "

     Case 6: s100$ = "шестьсот "

     Case 7: s100$ = "семьсот "

     Case 8: s100$ = "восемьсот "

     Case 9: s100$ = "девятьсот "

   End Select

   '

   ' десятки

   Rest% = Rest% Mod 100: Rest1% = Rest% \ 10

   s1$ = ""

   Select Case Rest1%

     Case 0: s10$ = ""

     Case 1  ' особый случай

       Select Case Rest%

         Case 10: s10$ = "десять "

         Case 11: s10$ = "одиннадцать "

         Case 12: s10$ = "двенадцать "

         Case 13: s10$ = "тринадцать "

         Case 14: s10$ = "четырнадцать "

         Case 15: s10$ = "пятнадцать "

         Case 16: s10$ = "шестнадцать "

         Case 17: s10$ = "семнадцать "

         Case 18: s10$ = "восемнадцать "

         Case 19: s10$ = "девятнадцать "

       End Select

     Case 2: s10$ = "двадцать "

     Case 3: s10$ = "тридцать "

     Case 4: s10$ = "сорок "

     Case 5: s10$ = "пятьдесят "

     Case 6: s10$ = "шестьдесят "

     Case 7: s10$ = "семьдесят "

     Case 8: s10$ = "восемьдесят "

     Case 9: s10$ = "девяносто "

   End Select

   '

   If Rest1% <> 1 Then  ' единицы

     Select Case Rest% Mod 10

       Case 1

         Select Case Rod%

           Case 1: s1$ = "один "

           Case 2: s1$ = "одна "

           Case 3: s1$ = "одно "

         End Select

         EndWord$ = w1$

       Case 2

         If Rod% = 2 Then s1$ = "две " Else s1$ = "два "

         EndWord$ = w2to4$

       Case 3: s1$ = "три ": EndWord$ = w2to4$  

       Case 4: s1$ = "четыре ": EndWord$ = w2to4$

       Case 5: s1$ = "пять "

       Case 6: s1$ = "шесть "

       Case 7: s1$ = "семь "

       Case 8: s1$ = "восемь "

       Case 9: s1$ = "девять "

     End Select

   End If

   '

   ' сборка строки

   Summa$ = RTrim$(RTrim$(s100$ + s10$ + s1$ + EndWord$) + " " + Summa$)

End Sub

Ну, пока все. Жду новых вопросов и сообщений! Буду благодарен за присланные интересные ссылки.

И еще. Поскольку у нас появилось много новых подписчиков, думаю будет небесполезным разместить здесь ссылку на самоучитель по Excel, с которого, собственно, все и началось - http://www.eliteclub.h10.ru/excel/excel.html

С уважением,
Александр РАСЕВ