Option Explicit
Function GetNumeric(CellRef As String)
Dim StringLength As Integer, i As Integer, result As String
StringLength = Len(CellRef)
For i = 1 To StringLength
If IsNumeric(Mid(CellRef, i, 1)) Then result = result & Mid(CellRef, i, 1)
Next i
GetNumeric = result
End Function
Sub test()
Sheets("Sheet2").Select
Range("A1").Select
'MsgBox (GetNumeric(ActiveCell.Value))
While ActiveCell.Value <> ""
ActiveCell.Offset(0, 1).Value = Replace(ActiveCell.Value, GetNumeric(ActiveCell.Value), LCase(NumToWords(GetNumeric(ActiveCell.Value))))
ActiveCell.Offset(0, 2).Value = translate_using_vba(ActiveCell.Offset(0, 1).Value, "bn")
ActiveCell.Offset(1, 0).Select
Wend
ActiveSheet.Cells.Columns.AutoFit
End Sub
'Main Function
Function NumToWords(ByVal MyNumber)
'Written by Philip Treacy
'http://www.myonlinetraininghub.com/convert-numbers-currency-to-words-with-excel-vba
'Feb 2014
'Based on code from Microsoft http://support.microsoft.com/kb/213360
'This code is not guaranteed to be error free. No warranty is implied or expressed. Use at your own risk and carry out your own testing
Dim Units As String
Dim SubUnits As String
Dim TempStr As String
Dim DecimalPlace As Integer
Dim Count As Integer
Dim DecimalSeparator As String
Dim UnitName As String
Dim SubUnitName As String
Dim SubUnitSingularName As String
DecimalSeparator = "."
ReDim Place(9) As String
Place(2) = " Thousand "
Place(3) = " Million "
Place(4) = " Billion "
Place(5) = " Trillion "
' Convert MyNumber to STRING and TRIM white space
MyNumber = Trim(CStr(MyNumber))
'If MyNumber is blank then exit
If MyNumber = "" Then
NumToWords = ""
Exit Function
End If
' Find Position of decimal place, 0 if none.
DecimalPlace = InStr(MyNumber, DecimalSeparator)
' Convert SubUnits and set MyNumber to Units amount.
If DecimalPlace > 0 Then
SubUnits = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
TempStr = GetHundreds(Right(MyNumber, 3))
If TempStr <> "" Then Units = TempStr & Place(Count) & Units
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
NumToWords = Application.Trim(Units)
End Function
' Converts a number from 100-999 into text
Function GetHundreds(ByVal MyNumber)
Dim result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
' Convert the hundreds place.
If Mid(MyNumber, 1, 1) <> "0" Then
result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
End If
' Convert the tens and ones place.
If Mid(MyNumber, 2, 1) <> "0" Then
result = result & GetTens(Mid(MyNumber, 2))
Else
result = result & GetDigit(Mid(MyNumber, 3))
End If
GetHundreds = result
End Function
' Converts a number from 10 to 99 into text.
Function GetTens(TensText)
Dim result As String
result = "" ' Null out the temporary function value.
If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...
Select Case Val(TensText)
Case 10: result = "Ten"
Case 11: result = "Eleven"
Case 12: result = "Twelve"
Case 13: result = "Thirteen"
Case 14: result = "Fourteen"
Case 15: result = "Fifteen"
Case 16: result = "Sixteen"
Case 17: result = "Seventeen"
Case 18: result = "Eighteen"
Case 19: result = "Nineteen"
Case Else
End Select
Else ' If value between 20-99...
Select Case Val(Left(TensText, 1))
Case 2: result = "Twenty "
Case 3: result = "Thirty "
Case 4: result = "Forty "
Case 5: result = "Fifty "
Case 6: result = "Sixty "
Case 7: result = "Seventy "
Case 8: result = "Eighty "
Case 9: result = "Ninety "
Case Else
End Select
result = result & GetDigit(Right(TensText, 1)) ' Retrieve ones place.
End If
GetTens = result
End Function
' Converts a number from 1 to 9 into text.
Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "One"
Case 2: GetDigit = "Two"
Case 3: GetDigit = "Three"
Case 4: GetDigit = "Four"
Case 5: GetDigit = "Five"
Case 6: GetDigit = "Six"
Case 7: GetDigit = "Seven"
Case 8: GetDigit = "Eight"
Case 9: GetDigit = "Nine"
Case Else: GetDigit = ""
End Select
End Function
Function translate_using_vba(str, langchoice) As String
' Tools Refrence Select Microsoft internet Control
Dim IE As Object, i As Long
Dim inputstring As String, outputstring As String, text_to_convert As String, result_data As String
Dim CLEAN_DATA
Set IE = CreateObject("InternetExplorer.application")
' TO CHOOSE INPUT LANGUAGE
inputstring = "auto"
' TO CHOOSE OUTPUT LANGUAGE
outputstring = langchoice
text_to_convert = str
'open website
IE.Visible = False
IE.navigate "http://translate.google.com/#" & inputstring & "/" & outputstring & "/" & text_to_convert
Do Until IE.ReadyState = 4
DoEvents
Loop
Application.Wait (Now + TimeValue("0:00:10"))
Do Until IE.ReadyState = 4
DoEvents
Loop
IE.Quit
translate_using_vba = IE.Document.getElementsByclassname("tlid-translation translation")(0).outertext
End Function
No comments:
Post a Comment