TOP

LibreOffice Calc 中用英文书写的金额

描述

LibreOffice Calc 没有可以在工作表上将数字显示为英文单词的内置函数,但您可以通过将以下 SpellNum_YouLibreCalc 函数宏插入到 Basic 模块中来添加此功能。

此函数允许您使用公式将数字转换为任何货币的单词,例如数字 22.50 将被读作 "Twenty Two Dollars and Fifty Cents" 或者 "Twenty Two Pesos and Fifty Centavos"

如果您使用 LO Calc 作为模板来填写支票或其他会计凭证,这将非常有用。



StarBASIC SpellNum_YouLibreCalc 函数的代码

要添加您自己的英文求和函数,请打开菜单 Tools - Macros - Edit Macros...,选择 Module1 并将以下代码文本复制到所选模块:

  1. Function SpellNum_YouLibreCalc(ByVal MyNumber, Optional CurrNameS, Optional CurrNamePl, Optional CentNameS, Optional CentNamePl, Optional Modifier, Optional CurrPlace, Optional AddZero)  
  2.     'moonexcel.com.ua  
  3.     Dim Place(9) As String     
  4.     Dim FCalc    As Object  
  5.     Dim Dollars, Cents, Temp, DecimalPlace, Count, CalcResult   
  6.       
  7.     If Len(MyNumber) = 0 Then Exit Function     
  8.       
  9.     FCalc = CreateUnoService("com.sun.star.sheet.FunctionAccess")  
  10.       
  11.     If IsMissing(CurrNameS)  Then CurrNameS  = 0  
  12.     If IsMissing(CurrNamePl) Then CurrNamePl = 0  
  13.     If IsMissing(CentNameS)  Then CentNameS  = 0  
  14.     If IsMissing(CentNamePl) Then CentNamePl = 0  
  15.     If IsMissing(Modifier)   Then Modifier   = 0             
  16.     If IsMissing(CurrPlace)  Then CurrPlace  = 0  
  17.     If IsMissing(AddZero)    Then AddZero    = 0  
  18.                  
  19.     If CurrNameS  = 0 Then CurrNameS  = ""              
  20.     If CurrNamePl = 0 Then CurrNamePl = ""  
  21.     If CentNameS  = 0 Then CentNameS  = ""        
  22.     If CentNamePl = 0 Then CentNamePl = ""        
  23.       
  24.     Place(2) = " Thousand "  
  25.     Place(3) = " Million "  
  26.     Place(4) = " Billion "  
  27.     Place(5) = " Trillion "   
  28.   
  29.     MyNumber     = Trim(Str(MyNumber))  
  30.     ValMyNumber  = Val(MyNumber)  
  31.     DecimalPlace = InStr(MyNumber, ".")  
  32.       
  33.     If DecimalPlace > 0 Then        
  34.       If Modifier = 5 Then  
  35.         Cents = GetHundreds(Left(Mid(MyNumber, DecimalPlace + 1) & "000", 3))  
  36.       Else   
  37.         Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))  
  38.       End If          
  39.         
  40.       MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))  
  41.     End If          
  42.            
  43.     Count = 1     
  44.          
  45.     Do While MyNumber <> ""  
  46.         Temp = GetHundreds(Right(MyNumber, 3))            
  47.         If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars            
  48.         If Len(MyNumber) > 3 Then  
  49.             MyNumber = Left(MyNumber, Len(MyNumber) - 3)  
  50.         Else  
  51.             MyNumber = ""  
  52.         End If            
  53.         Count = Count + 1  
  54.     Loop                                              
  55.                                           
  56.     If Modifier = 3 Then  
  57.       CalcResult = FCalc.callFunction("MOD", Array(ValMyNumber, 1))  
  58.       CalcResult = FCalc.callFunction("ROUND", Array(CalcResult, 2))                       
  59.       Cents      = Str(CalcResult * 100) & "/100"   
  60.     End If  
  61.       
  62.     If Modifier = 4 Then          
  63.       CalcResult = FCalc.callFunction("MOD", Array(ValMyNumber, 1))                    
  64.       CalcResult = FCalc.callFunction("ROUND", Array(CalcResult, 3))                        
  65.       Cents      = Str(CalcResult * 1000) & "/1000"                
  66.     End If  
  67.       
  68.     If CurrPlace = 1 Then  
  69.         If Len(Dollars) = 0 Then   
  70.        Dollars =  CurrNamePl & " Zero"  
  71.      ElseIf Dollars = "One" Then  
  72.        Dollars = CurrNameS & " One"  
  73.      Else  
  74.        Dollars = CurrNamePl & " " & Dollars   
  75.      End If        
  76.     Else  
  77.      If Len(Dollars) = 0 Then   
  78.        Dollars = "Zero " & CurrNamePl  
  79.      ElseIf Dollars = "One" Then  
  80.        Dollars = "One " & CurrNameS  
  81.      Else  
  82.        Dollars = Dollars & " " & CurrNamePl          
  83.      End If   
  84.     End If             
  85.       
  86.     LenCents = Len(Cents)    
  87.       
  88.     If CurrPlace = 1 Then           
  89.      If LenCents = 0 Then   
  90.        Cents = CentNamePl & " Zero"  
  91.      ElseIf Cents = "One" Then  
  92.        Cents = CentNamePl & " One"  
  93.      Else  
  94.        Cents = CentNamePl & " " & Cents   
  95.      End If  
  96.     Else  
  97.         If LenCents = 0 Then   
  98.        Cents = "Zero " & CentNamePl  
  99.      ElseIf Cents = "One" Then  
  100.        Cents = "One " & CentNameS  
  101.      Else  
  102.        Cents = Cents & " " & CentNamePl          
  103.      End If        
  104.     End If  
  105.       
  106.     If Modifier <> 2 Then Cents = " and " & Cents        
  107.           
  108.     If LenCents = 0 And AddZero <> 1 Then Cents = ""       
  109.       
  110.     Select Case Modifier  
  111.       Case 1:    SpellNumber = Dollars  
  112.       Case 2:    SpellNumber = Cents  
  113.       Case Else: SpellNumber = Dollars & Cents      
  114.     End Select             
  115.                                 
  116.     SpellNum_YouLibreCalc = FCalc.callFunction("TRIM", Array(SpellNumber))  
  117. End Function  
  118.   
  119.   
  120. Function GetHundreds(ByVal MyNumber)  
  121.     Dim Result As String  
  122.     If Val(MyNumber) = 0 Then Exit Function  
  123.     MyNumber = Right("000" & MyNumber, 3)  
  124.     'Перетворити розряд сотень  
  125.     If Mid(MyNumber, 1, 1) <> "0" Then  
  126.         Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "  
  127.     End If  
  128.     'Перетворити розряди десятків і одиниць  
  129.     If Mid(MyNumber, 2, 1) <> "0" Then  
  130.         Result = Result & GetTens(Mid(MyNumber, 2))  
  131.     Else  
  132.         Result = Result & GetDigit(Mid(MyNumber, 3))  
  133.     End If  
  134.     GetHundreds = Result  
  135. End Function  
  136.   
  137.   
  138. Function GetTens(TensText)  
  139.     Dim Result As String  
  140.     'Обнулити значення тимчасової функції  
  141.     Result = ""  
  142.     'Якщо значення між 10-19...  
  143.     If Val(Left(TensText, 1)) = 1 Then     
  144.         Select Case Val(TensText)  
  145.             Case 10: Result = "Ten"  
  146.             Case 11: Result = "Eleven"  
  147.             Case 12: Result = "Twelve"  
  148.             Case 13: Result = "Thirteen"  
  149.             Case 14: Result = "Fourteen"  
  150.             Case 15: Result = "Fifteen"  
  151.             Case 16: Result = "Sixteen"  
  152.             Case 17: Result = "Seventeen"  
  153.             Case 18: Result = "Eighteen"  
  154.             Case 19: Result = "Nineteen"  
  155.             Case Else  
  156.         End Select  
  157.     Else 'Якщо значення між 20-99...  
  158.         Select Case Val(Left(TensText, 1))  
  159.             Case 2: Result = "Twenty "  
  160.             Case 3: Result = "Thirty "  
  161.             Case 4: Result = "Forty "  
  162.             Case 5: Result = "Fifty "  
  163.             Case 6: Result = "Sixty "  
  164.             Case 7: Result = "Seventy "  
  165.             Case 8: Result = "Eighty "  
  166.             Case 9: Result = "Ninety "  
  167.             Case Else  
  168.         End Select  
  169.         'Отримати своє місце  
  170.         Result = Result & GetDigit(Right(TensText, 1))    
  171.     End If  
  172.     GetTens = Result  
  173. End Function  
  174.   
  175.   
  176. Function GetDigit(Digit)  
  177.     Select Case Val(Digit)  
  178.         Case 1: GetDigit = "One"  
  179.         Case 2: GetDigit = "Two"  
  180.         Case 3: GetDigit = "Three"  
  181.         Case 4: GetDigit = "Four"  
  182.         Case 5: GetDigit = "Five"  
  183.         Case 6: GetDigit = "Six"  
  184.         Case 7: GetDigit = "Seven"  
  185.         Case 8: GetDigit = "Eight"  
  186.         Case 9: GetDigit = "Nine"  
  187.         Case Else: GetDigit = ""  
  188.     End Select  
  189. End Function  

然后,关闭 Macro Editor,返回到 LibreOffice Calc,选择任意单元格并使用我们的新函数。

使用扩展

之后,该功能将在 LibreOffice Calc 中打开的所有文件中可用。