Как едно число да се покаже словом?
Здравейте. Благодаря за добре представените уроци. Определено са ценни и важни и винаги има какво да се научи или припомни, особено ако не се ползва често дадена операция. Бих искал да разбера какъв е начина едно число например 1536.15 от дадена клетка, да се покаже словом в друга клетка. И това дали ще е в лв, евро или само текст например от форматирането на коя клетка зависи. Благодаря.
Отваряш MS Word.\n\nЩракваш Tools - Macro - Visual basic Editor.\n\nСъздаваш един нов модул : Insert - Module\n\nКопираш кода и го поставяш в прозореца на модула.\n\nЗаписваш го със Save.\n\nИзвиква се с ToWords.\n\n\n\nPublic Function ToWords(ByVal dblValue As Double, Optional Measure As Variant, Optional Gender As Variant, Optional NumScale As Variant) As String\n Dim vDigits As Variant\n Dim vGenderDigits As Variant\n Dim vValue As Variant\n Dim lIdx As Long\n Dim lDigit As Long\n Dim sResult As String\n \n \'--- fix optional params default values\n If IsMissing(Gender) Then\n Gender = vbNullString\n End If\n If IsMissing(NumScale) Then\n NumScale = 2\n End If\n \'--- init digits (incl. gender ones)\n 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))\n vGenderDigits = Split(Join(vDigits))\n Select Case Left$(Gender, 1)\n Case vbNullString, ChrW(&H4D), \"\"\n vGenderDigits(1) = ChrW(&H435) & ChrW(&H434) & ChrW(&H438) & ChrW(&H43D)\n vGenderDigits(2) = ChrW(&H434) & ChrW(&H432) & ChrW(&H430)\n Case ChrW(&H46)\n vGenderDigits(1) = ChrW(&H435) & ChrW(&H434) & ChrW(&H43D) & ChrW(&H430)\n End Select\n \'--- split input value on decimal point and pad w/ zeroes\n vValue = Mid$(Format$(0, ChrW(&H30) & ChrW(&H2E) & ChrW(&H30)), 2, 1)\n vValue = Split(Format$(Abs(dblValue), ChrW(&H30) & ChrW(&H2E) & String(NumScale, ChrW(&H30))), vValue)\n vValue(0) = Right$(String$(18, ChrW(&H30)) & vValue(0), 18)\n \'--- loop input digits from right to left\n For lIdx = 1 To Len(vValue(0))\n If lIdx <= 3 Then\n lDigit = Mid$(vValue(0), Len(vValue(0)) - lIdx + 1, 1)\n Else\n lDigit = Mid$(vValue(0), Len(vValue(0)) - lIdx - 1, 3)\n lIdx = lIdx + 2\n End If\n If lDigit <> 0 Then\n \'--- separate by space (first time prepend ChrW(&H438) too)\n If LenB(sResult) <> 0 And (lIdx <> 2 Or lDigit <> 1) Then\n If InStr(sResult, ChrW(&H20) & ChrW(&H438) & ChrW(&H20)) = 0 Then\n sResult = ChrW(&H20) & ChrW(&H438) & ChrW(&H20) & sResult\n Else\n sResult = ChrW(&H20) & sResult\n End If\n End If\n Select Case lIdx\n Case 1\n sResult = vGenderDigits(lDigit) & sResult\n Case 2\n If lDigit = 1 Then\n \'--- 11 to 19 special wordforms\n If LenB(sResult) <> 0 Then\n sResult = Replace(LTrim$(sResult), vGenderDigits(1), ChrW(&H435) & ChrW(&H434) & ChrW(&H438))\n 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)\n Else\n sResult = ChrW(&H434) & ChrW(&H435) & ChrW(&H441) & ChrW(&H435) & ChrW(&H442)\n End If\n Else\n sResult = IIf(lDigit = 2, ChrW(&H434) & ChrW(&H432) & ChrW(&H430), vDigits(lDigit)) & ChrW(&H434) & ChrW(&H435) & ChrW(&H441) & ChrW(&H435) & ChrW(&H442) & sResult\n End If\n Case 3\n \'--- hundreds have special suffixes for 2 and 3\n Select Case lDigit\n Case 1\n sResult = ChrW(&H441) & ChrW(&H442) & ChrW(&H43E) & sResult\n Case 2, 3\n sResult = vDigits(lDigit) & ChrW(&H441) & ChrW(&H442) & ChrW(&H430) & sResult\n Case Else\n sResult = vDigits(lDigit) & ChrW(&H441) & ChrW(&H442) & ChrW(&H43E) & ChrW(&H442) & ChrW(&H438) & ChrW(&H43D) & sResult\n End Select\n Case 6\n \'--- thousands are in feminine gender\n Select Case lDigit\n Case 1\n sResult = ChrW(&H445) & ChrW(&H438) & ChrW(&H43B) & ChrW(&H44F) & ChrW(&H434) & ChrW(&H430) & sResult\n Case Else\n sResult = ToWords(lDigit, vbNullString, Gender:=ChrW(&H46)) & ChrW(&H20) & ChrW(&H445) & ChrW(&H438) & ChrW(&H43B) & ChrW(&H44F) & ChrW(&H434) & ChrW(&H438) & sResult\n End Select\n Case 9, 12, 15\n \'--- no special cases for bigger values\n 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) _\n & IIf(lDigit <> 1, ChrW(&H430), vbNullString) & sResult\n End Select\n End If\n Next\n \'--- handle zero and negative values\n If LenB(sResult) = 0 Then\n sResult = vDigits(0)\n End If\n If dblValue < 0 Then\n sResult = ChrW(&H43C) & ChrW(&H438) & ChrW(&H43D) & ChrW(&H443) & ChrW(&H441) & ChrW(&H20) & sResult\n End If\n \'--- apply measure (use Measure:=vbNullString for none)\n If IsMissing(Measure) Then\n 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)\n Gender = ChrW(&H4D) & ChrW(&H46)\n End If\n If LenB(Measure) <> 0 Then\n If Right$(sResult, Len(vDigits(0))) = vDigits(0) And Val(vValue(1)) <> 0 And InStr(Measure, ChrW(&H7C)) > 0 Then\n sResult = ToWords(IIf(dblValue < 0, -1, 1) * Val(vValue(1)), Split(Measure, ChrW(&H7C))(1), Mid$(Gender, 2))\n Else\n sResult = sResult & ChrW(&H20) & Split(Measure, ChrW(&H7C))(0)\n If Val(vValue(1)) <> 0 Or InStr(Measure, ChrW(&H7C)) > 0 Then\n sResult = sResult & ChrW(&H20) & ChrW(&H438) & ChrW(&H20) & vValue(1)\n End If\n If InStr(Measure, ChrW(&H7C)) > 0 Then\n sResult = sResult & ChrW(&H20) & Split(Measure, ChrW(&H7C))(1)\n End If\n sResult = UCase$(Left$(sResult, 1)) & Mid$(sResult, 2)\n End If\n End If\n ToWords = sResult\nEnd Function\n\nPublic Function ToAllWords(ByVal dblValue As Double) As String\n 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)))\nEnd Function\n\n
Предполагах че има по-лесен начин като функция, но явно не е така. Все пак много благодаря за информацията.
Вашият отговор
