Results 1 to 1 of 1
Hybrid View
-
7th November 2018 14:06 #1Registered User
Join Date: Oct:2003
Posts: 1,861
:
, ( ) Excel 2003/Win7-32, , Office 2016/Win10-64. . , , ToWords .
:
Win Locale:Bulgarian - .Code:Attribute VB_Name = "Module1" ' VBA Microsoft Excel ' Copyright (c) 2012 Unicontsoft (wqweto@gmail.com) ' ' ' ' ( ), ( ' ) ( ). ' ' ' ' VBA Excel Alt+F11 VBAProject ' (Module1). ( https://gist.github.com/4118581) Module1 VBA ' . ' ' ' ' , : ' ' = ToWords(123) ' ' ( ) ' ' = ToWord(A1) ' ' A1 . ' ' dblValue e 999 . ' ' = ToWords(167.42) -> . 42 . ' = ToWords(-12341235) -> ' . 0 . ' = ToWords(341.6, "|", "F") -> 60 ' '===================================================================================================================== Public Function ToWords(ByVal dblValue As Double, Optional Measure As Variant, Optional Gender As String) As String Dim vDigits As Variant Dim vGenderDigits As Variant Dim vValue As Variant Dim lIdx As Long Dim lDigit As Long '--- init digits (incl. gender ones) vDigits = Split(" ") vGenderDigits = vDigits Select Case Gender Case vbNullString, "M" vGenderDigits(1) = "" vGenderDigits(2) = "" Case "F" vGenderDigits(1) = "" End Select '--- split input value on decimal point and pad w/ zeroes vValue = Mid$(Format(0, "0.0"), 2, 1) vValue = Split(Format(Abs(dblValue), "0.00##"), vValue) vValue(0) = Right$(String(18, "0") & vValue(0), 18) '--- loop input digits from right to left For lIdx = 1 To Len(vValue(0)) If lIdx <= 3 Then lDigit = Mid$(vValue(0), Len(vValue(0)) - lIdx + 1, 1) Else lDigit = Mid$(vValue(0), Len(vValue(0)) - lIdx - 1, 3) lIdx = lIdx + 2 End If If lDigit <> 0 Then '--- separate by space (first time prepend "" too) If LenB(ToWords) <> 0 And (lIdx <> 2 Or lDigit <> 1) Then If InStr(ToWords, " ") = 0 Then ToWords = " " & ToWords Else ToWords = " " & ToWords End If End If Select Case lIdx Case 1 ToWords = vGenderDigits(lDigit) & ToWords Case 2 If lDigit = 1 Then '--- 11 to 19 special wordforms If LenB(ToWords) <> 0 Then ToWords = Replace(LTrim$(ToWords), vGenderDigits(1), "") ToWords = Replace(ToWords, vGenderDigits(2), "") & "" Else ToWords = "" End If Else ToWords = IIf(lDigit = 2, "", vDigits(lDigit)) & "" & ToWords End If Case 3 '--- hundreds have special suffixes for 2 and 3 Select Case lDigit Case 1 ToWords = "" & ToWords Case 2, 3 ToWords = vDigits(lDigit) & "" & ToWords Case Else ToWords = vDigits(lDigit) & "" & ToWords End Select Case 6 '--- thousands are in feminine gender Select Case lDigit Case 1 ToWords = "" & ToWords Case Else ToWords = ToWords(lDigit, vbNullString, Gender:="F") & " " & ToWords End Select Case 9, 12, 15 '--- no special cases for bigger values ToWords = ToWords(lDigit, vbNullString) & " " & Split(" ")((lIdx - 9) \ 3) _ & IIf(lDigit <> 1, "", vbNullString) & ToWords End Select End If Next '--- handle zero and negative values If LenB(ToWords) = 0 Then ToWords = vDigits(0) ElseIf dblValue < 0 Then ToWords = " " & ToWords End If '--- apply measure (use vbNullString for none) If IsMissing(Measure) Then Measure = ".|." End If If LenB(Measure) <> 0 Then ToWords = ToWords & " " & Split(Measure, "|")(0) & " " & Val(vValue(1)) If InStr(Measure, "|") > 0 Then ToWords = ToWords & " " & Split(Measure, "|")(1) End If ToWords = UCase$(Left$(ToWords, 1)) & Mid$(ToWords, 2) End If End Function
, VBA Excel 2016/Win10-64 Excel . Win7-32, 2003 2016 Excel. Win7-32 Excel , - . , Excel ASCII, UTF8 ( 1251 - ), Win10-64 + Excel 2016.
EDIT: , .Last edited by Jonata; 7th November 2018 at 15:56.




Reply With Quote
...
7th May 2023, 14:24 in