FREE
Стефан
Присъединил се: август 2020
Постоянство бета
0
Аула точки
6485
Постижения
44
Изгледани уроци
798
Харесани отговора
3
Общо отговора
1
Въпроса
0
Последвани
0
Интереси
Уеб дизайн
Wordpress
HTML
CSS
Уеб сайтове с Wordpress
Потвърдени умения
от харесани отговори разделени по софтуер
3
Microsoft Excel
Записани курсове
Завършени обучения
PDF удостоверения могат да се се свалят от лични настройки и документи.
Постижения
В АУЛА винаги се стремим да подобрим начина на обучение и поради това въведохме точкова система с постижения.
Принципът на работа е съвсем прост - за определено действие в АУЛА (като преминати уроци, преминат тест,
отговор на въпрос от друг колега) се получават точки и постижения. Така ще възнаграждаваме хората, които
регулярно гледат уроците и помагат на другите в сайта.
Записани осем курса!
Нощна птица!
Записани седем курса!
Професионалист!
Потенциал!
Благодарност
Научихте 200 урока!
Научихте 150 урока!
Записани шест курса!
Научихте 120 урока!
Научихте 100 урока!
Научихте 80 урока!
Записани пет курса!
Записани четири курса!
Богатството на образованието
Непрекъснато израстване
Образованието е ключът
Записани три курса!
Инвестиция в знания
Обучение под пара :)
Записан втори курс!
Продължаваме напред
Научихте 40 урока!
Три влизания за една седмица
Най-мощното оръжие
Научихте 20 урока!
Пет влизания за една седмица!
Който дава живот на ума и знанието, той не умира
Здрав напредък
Научихте десет урока!
Доказани знания
Научихте пет урока!
Добро начало
Напредък
Стабилен напредък
Добро утро!
Първи стъпки
Напред, напред, напред
Който се учи, той ще сполучи
Последни форум дискусии
Отваряш 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
