| |
|
|
| |
|
|
 Флетч
07.08.2013 8:26:06
|
|
|
Может у кого-нибудь есть макрос для Excel «сумма прописью» с белорусскими рублями. Не надстройка, а именно макрос. Спасибо.
Беларусь
|
|
|
|
| |
|
|
| |
<< к списку вопросов
|
| |
ОТВЕТЫ:
|
|
|
Fil
07.08.2013 8:37:29
|
|
|
Надстройка есть
Беларусь
|
|
|
|
Флетч
07.08.2013 8:39:49
|
|
|
Александр, надстройка есть у всех. Мне надо макрос :)
Беларусь
|
|
|
|
Fil
07.08.2013 8:40:51
|
|
|
Вот нашёл:
– откройте меню Сервис –> Макрос –> Редактор Visual Basic (или нажмите Alt + F11);
– в открывшемся окне Microsoft Visual Basic выберите меню Insert –> Module;
– откроется окно Module1 (Code), введите (скопируйте и вставьте) в этом окне (без изменений!) следующий код:
Option Explicit
Function Сумма_прописью(s As Currency) As String
Dim triad(4) As Integer
Dim numb1(0 To 19) As String
Dim numb2(0 To 9) As String
Dim numb3(0 To 9) As String
Dim ss As Currency
Dim txt As String
Dim n As Integer
Dim i As Integer
If s = 0 Then
Сумма_прописью = «»
Exit Function
End If
ss = s
triad(1) = ss - Int(ss / 1000) * 1000
ss = Int(ss / 1000)
triad(2) = ss - Int(ss / 1000) * 1000
ss = Int(ss / 1000)
triad(3) = ss - Int(ss / 1000) * 1000
ss = Int(ss / 1000)
triad(4) = ss - Int(ss / 1000) * 1000
ss = Int(ss / 1000)
numb1(0) = «»
numb1(1) = «один »
numb1(2) = «два »
numb1(3) = «три »
numb1(4) = «четыре »
numb1(5) = «пять »
numb1(6) = «шесть »
numb1(7) = «семь »
numb1(8) = «восемь »
numb1(9) = «девять »
numb1(10) = «десять »
numb1(11) = «одиннадцать »
numb1(12) = «двенадцать »
numb1(13) = «тринадцать »
numb1(14) = «четырнадцать »
numb1(15) = «пятнадцать »
numb1(16) = «шестнадцать »
numb1(17) = «семнадцать »
numb1(18) = «восемнадцать »
numb1(19) = «девятнадцать »
numb2(0) = «»
numb2(1) = «»
numb2(2) = «двадцать »
numb2(3) = «тридцать »
numb2(4) = «сорок »
numb2(5) = «пятьдесят »
numb2(6) = «шестьдесят »
numb2(7) = «семьдесят »
numb2(8) = «восемьдесят »
numb2(9) = «девяносто »
numb3(0) = «»
numb3(1) = «сто »
numb3(2) = «двести »
numb3(3) = «триста »
numb3(4) = «четыреста »
numb3(5) = «пятьсот »
numb3(6) = «шестьсот »
numb3(7) = «семьсот »
numb3(8) = «восемьсот »
numb3(9) = «девятьсот »
txt = «»
If ss <> 0 Then
n = MsgBox(«Сумма выходит за границы формата», 16, «Сумма прописью»)
Сумма_прописью = «»
Exit Function
End If
For i = 4 To 1 Step -1
n = 0
If triad(i) > 0 Then
n = Int(triad(i) / 100)
txt = txt & numb3(n)
n = Int((triad(i) - n * 100) / 10)
txt = txt & numb2(n)
If n < 2 Then
n = triad(i) - (Int(triad(i) / 10) - n) * 10
Else
n = triad(i) - Int(triad(i) / 10) * 10
End If
Select Case n
Case 1
If i = 2 Then txt = txt & «одна » Else txt = txt & «один »
Case 2
If i = 2 Then txt = txt & «две » Else txt = txt & «два»
Case Else
txt = txt & numb1(n)
End Select
Select Case i
Case 2
If n = 0 Or n > 4 Then
txt = txt + «тысяч »
Else
If n = 1 Then txt = txt + «тысяча » Else txt = txt + «тысячи »
End If
Case 3
If n = 0 Or n > 4 Then
txt = txt + «миллионов »
Else
If n = 1 Then txt = txt + «миллион » Else txt = txt + «миллиона »
End If
Case 4
If n = 0 Or n > 4 Then
txt = txt + «миллиардов »
Else
If n = 1 Then txt = txt + «миллиард » Else txt = txt + «миллиарда »
End If
End Select
End If
Next i
If n = 0 Or n > 4 Then
txt = txt + «рублей»
Else
If n = 1 Then txt = txt + «рубль» Else txt = txt + «рубля»
End If
txt = UCase$(Left$(txt, 1)) & Mid$(txt, 2)
Сумма_прописью = txt
End Function
Private Sub Command1_Click()
Text1.Text = Сумма_прописью(Text1.Text)
End Sub
Беларусь
|
|
|
|
Fil
07.08.2013 8:43:55
|
|
|
Отсюда
buh galter.by/to pic/10529/
Беларусь
|
|
|
|
Флетч
07.08.2013 8:47:55
|
|
|
Еще раз спасибо. Топик этот видел, это не совсем то.
Беларусь
|
|
|
|
Фея с топором
07.08.2013 9:01:19
|
|
|
Флетч почту посмотрите)))
Беларусь
|
|
|
|
Fil
07.08.2013 9:01:54
|
|
|
planetaexcel. ru/ - здесь смотрели?
Беларусь
|
|
|
|
"Анонимно"
07.08.2013 9:06:37
|
|
|
вы эту фенкцию и сами можете прописать))))
Беларусь
|
|
|
|
"Анонимно"
07.08.2013 9:07:31
|
|
|
и еще один момент офис какой у вас?
Беларусь
|
|
|
|
Флетч
07.08.2013 9:33:19
|
|
|
Почту смотрел. Спасибо, это примерно тоже самое, что Фил выкладывал. Я не хочу прописывать функции для каждой валюты, если существует что-то готовое. Естественно, кроме белорусских рублей мне нужны доллары, евро и Россия.
И хотелось бы, чтобы макрос работал в любом офисе.
Беларусь
|
|
|
|
Фея с топором
07.08.2013 9:36:17
|
|
|
Почту смотрел. Спасибо, это примерно тоже самое, что Фил выкладывал. Я не хочу прописывать функции для каждой валюты, если существует что-то готовое. Естественно, кроме белорусских рублей мне нужны доллары, евро и Россия.
И хотелось бы, чтобы макрос работал в любом офисе.
Эмммм... так а в чем проблема дописать под себя по готовому шаблону? И этот макрос работает в любом офисе. Сделайте выбор валюты отдельным выпадающим списком, и пропишите использование выбранной валюты в макросе дополнительно - делов то?
Беларусь
|
|
|
|
"Анонимно"
07.08.2013 9:38:01
|
|
|
Макрос самому можно написать ничего сложного.и будет так как вам нужно.
Беларусь
|
|
|
|
Флетч
07.08.2013 9:53:05
|
|
|
Я не умею дописывать макросы :(
Свой макрос я скачал вот тут:
h t tp ://e-kao. r u /sumprop
тут есть гривны, доллары, евро и просто рубли. Если это действительно просто, кто-нибудь может из «просто рублей» сделать бел. рубли (удалить копейки) , а в просто рубли добавить рос. рубли ?
Заодно и переименовать названия функций, а то больно длинные.
Беларусь
|
|
|
|
Флетч
07.08.2013 10:54:06
|
|
|
Не будет доброго совета ? (
Беларусь
|
|
|
|
Panda
07.08.2013 10:56:21
|
|
|
мне муж написал имеенно для бел.рублей, давайте свой емейл на panda. com @ mail. ru (без пробелов)- сброшу
Беларусь
|
|
|
|
Флетч
07.08.2013 11:17:10
|
|
|
Спасибо, Панда.
Беларусь
|
|
|
|
Panda
07.08.2013 11:23:47
|
|
|
только я не помню как его внедрять ;-)
Беларусь
|
|
|
|
Флетч
07.08.2013 11:57:26
|
|
|
В любом случае, Вы прислали настройку , а не макрос.
Беларусь
|
|
|
|
Panda
07.08.2013 13:32:56
|
|
|
простите
Беларусь
|
|
|
|
Флетч
07.08.2013 14:46:41
|
|
|
Ну что Вы :) Вам в любом случае огромное спасибо за отзывчивость :)
Беларусь
|
|
|
| |
<< к списку вопросов
1-20
|
|
| |
|
|
НА ОБУЧЕНИЕ «1С»