Може ли в MS Excel 2010 да се преобразува число в текст - от цифром в словом?
Мразя да ми се случва така, но се случва! Веднъж на 100 години ще ми се наложи да направя нещо, което някога е минало покрай ушите ми и се чудя къде съм спал.
Здравей,
ето един макрос който може да ти свърши работа.
Направен е за стойности във валута.
Предполагам, че за това ти трябва.
Function Spell(NumStr, i)
Static Units(20) As String, Decim(9) As String, Hundr(11) As String, Thous(5) As String, Thous1(5) As String
Static Units1(20) As String
Units(0) = ""
Units(1) = "един "
Units(2) = "два "
Units(3) = "три "
Units(4) = "четири "
Units(5) = "пет "
Units(6) = "шест "
Units(7) = "седем "
Units(8) = "осем "
Units(9) = "девет "
Units(10) = "десет "
Units(11) = "единадесет "
Units(12) = "дванадесет "
Units(13) = "тринадесет "
Units(14) = "четиринадесет "
Units(15) = "петнадесет "
Units(16) = "шестнадесет "
Units(17) = "седемнадесет "
Units(18) = "осемнадесет "
Units(19) = "деветнадесет "
Units1(0) = ""
Units1(1) = "една "
Units1(2) = "две "
Units1(3) = "три "
Units1(4) = "четири "
Units1(5) = "пет "
Units1(6) = "шест "
Units1(7) = "седем "
Units1(8) = "осем "
Units1(9) = "девет "
Units1(10) = "десет "
Units1(11) = "единадесет "
Units1(12) = "дванадесет "
Units1(13) = "тринадесет "
Units1(14) = "четиринадесет "
Units1(15) = "петнадесет "
Units1(16) = "шестнадесет "
Units1(17) = "седемнадесет "
Units1(18) = "осемнадесет "
Units1(19) = "деветнадесет "
Decim(0) = ""
Decim(1) = "двадесет "
Decim(2) = "тридесет "
Decim(3) = "четиридесет "
Decim(4) = "петдесет "
Decim(5) = "шестдесет "
Decim(6) = "седемдесет "
Decim(7) = "осемдесет "
Decim(8) = "деведесет "
Hundr(0) = ""
Hundr(1) = ""
Hundr(2) = "сто "
Hundr(3) = "двеста "
Hundr(4) = "триста "
Hundr(5) = "четиристотин "
Hundr(6) = "петстотин "
Hundr(7) = "шестстотин "
Hundr(8) = "седемстотин "
Hundr(9) = "осмстотин "
Hundr(10) = "деветстотин "
Thous(0) = ""
Thous(1) = ""
Thous(2) = "хиляди "
Thous(3) = "милиона "
Thous(4) = "милиарда "
Thous1(0) = ""
Thous1(1) = ""
Thous1(2) = "хиляда "
Thous1(3) = "милион "
Thous1(4) = "милиард "
Dim Num, RetStr
RetStr = ""
Num = CInt(NumStr)
If Num = 0 Then
Spell = RetStr
Exit Function
End If
If Num = 1 Then
Select Case i
Case 1
RetStr = "и " & Units(1) & Thous1(1)
Case 2
RetStr = Thous1(2)
Case Else
RetStr = Units(1) & Thous1(i)
End Select
Spell = RetStr
Exit Function
End If
RetStr = RetStr & "и " & Hundr(CInt(Left(NumStr, 1)) + 1)
If CInt(Right(NumStr, 2)) = 0 Then
Spell = RetStr & Thous(i)
Exit Function
End If
If Mid(NumStr, 2, 1) = "0" Or Mid(NumStr, 2, 1) = "1" Then
If i = 2 Then
Spell = RetStr & "и " & Units1(CInt(Mid(NumStr, 2, 2))) & Thous(i)
Else
Spell = RetStr & "и " & Units(CInt(Mid(NumStr, 2, 2))) & Thous(i)
End If
Exit Function
End If
If Right(NumStr, 1) = "0" Then
RetStr = RetStr & Decim(CInt(Mid(NumStr, 2, 1)) - 1)
Else
If i = 2 Then
RetStr = RetStr & Decim(CInt(Mid(NumStr, 2, 1)) - 1) & "и " & Units1(CInt(Right(NumStr, 1)))
Else
RetStr = RetStr & Decim(CInt(Mid(NumStr, 2, 1)) - 1) & "и " & Units(CInt(Right(NumStr, 1)))
End If
End If
Spell = RetStr & Thous(i)
End Function
Function Slov(ByVal Num As Currency)
Static c(5)
Dim NumStr, NumStr1, i, k
If Not IsNull(Num) Then
NumStr = Trim(CStr(Num))
If Num = 0 Then
Slov = "нула"
Exit Function
End If
Dim Buf As String:
If (Num < 0@) Then Buf = "минус " Else Buf = ""
Dim Frac As Currency: Frac = Abs(Num - Fix(Num))
If (Num < 0@ Or Frac <> 0@) Then Num = Abs(Fix(Num))
Dim AtLeastOne As Integer: AtLeastOne = Num >= 1
i = 1
NumStr = Num
Do
If Len(NumStr) > 3 Then
c(i) = Right$(NumStr, 3)
NumStr = Left$(NumStr, Len(NumStr) - 3)
i = i + 1
Else
c(i) = String(3 - Len(NumStr), "0") & NumStr
Exit Do
End If
Loop
NumStr = ""
For k = i To 1 Step -1
NumStr = NumStr & Spell(c(k), k)
Next k
Debug.Print NumStr
If Left(NumStr, 2) = "и " Then
NumStr = Right$(NumStr, Len(NumStr) - 2)
End If
If Left(NumStr, 2) = "и " Then
NumStr = Right$(NumStr, Len(NumStr) - 2)
End If
'стотинки
If (Frac = 0@) Then
Buf = Buf
ElseIf (Int(Frac * 100@) = Frac * 100@) Then
If AtLeastOne Then Buf = Buf & "и "
Buf = Buf & Format$(Frac * 100@, "00")
Else
If AtLeastOne Then Buf = Buf & "и "
Buf = Buf & Format$(Frac * 10000@, "0000")
End If
Slov = NumStr & Buf ' "лв. "
End If
End Function
Здравей Краси ! Ползвам този макрос, но има ли начин да го заредя за целия Excel така че, не всеки път като отварям програмата да трябва да го зареждам за конкретния файл?
Може - зареди го(макроса) в Personal.xls( или PERSONAL.XLSB), ако нямаш такъв файл - създай си го с EXCEL!
Здравей, Стефане.
Вариант е да си направиш един Tempalate ( същото е както и в Word ) и когато имаш такава задачка да си тръгваш от този tempalate.
И аз така правя...ама мислех че има като при Аутокад да го заредиш и да се ползва постоянно.
СТРАХОТНИ СТЕ ХОРА. Работи перфектно. Уникален проект!
Здравей, Симеон Симеонов.
Супер е, че ти е полезно!
Този код може ли да се бутне в ексел https://gist.github.com/wqweto/d7ca68a5fd0368c08158
@ Стефан. Не би трябвало да има проблем. Този който е постна по-горе мисля че ще ти свърши работа.
Да Краси ! Аз него си го ползвам :) Честит рожден ден, Краси Жив и здрав
Супер е че ти върши работа.
Благодаря за пожеланието!
Хм нещо не мога да го запиша като template.??? записва нещо после като отворя няма нищо. Ще помогне ли някой със стъпките на записа...
Следвах всичко по тази страница https://www.ablebits.com/office-addins-blog/2013/12/06/add-run-vba-macro-excel/
когато трябва да отворя макроса , бутоните са ми неактивни не знам защо???
Как да изпише стотинките дава ми грешка тук
'стотинки If (Frac = 0@) Then Buf = Buf ElseIf (Int(Frac * 100@) = Frac * 100@) Then If AtLeastOne Then Buf = Buf & "и " Buf = Buf & Format$(Frac * 100@, "00") Else If AtLeastOne Then Buf = Buf & "и " Buf = Buf & Format$(Frac * 10000@, "0000") End If Slov = NumStr & Buf ' "лв. " End If End Function
Frac
Здравейте, пробвах тази функция в макроса,но цифрите,изписани на кирилица излизат като въпросителни:???? Как мога да го променя,че да ми излизат цифрите на бълг език?
