lovelrajesh
New member
- Local time
- , 05:16
- Joined
- Jun 10, 2018
- Messages
- 12
i have an module which converts Number to Hindi Words like :
but problem is that it works finely in Excel due to support of sheet Name: Hindi Number.
My problem is that i Want to run it on Access platform. which require some little changes as i am Beginner in VBA so kindly please help.
KIndly Please Help. to run in Access.
1000.00 | एक हजार रुपये शून्य पैसे मात्र |
but problem is that it works finely in Excel due to support of sheet Name: Hindi Number.
My problem is that i Want to run it on Access platform. which require some little changes as i am Beginner in VBA so kindly please help.
Code:
Option Explicit
Function NumberToWord(Num As Double, Optional ZeroPaise As Boolean = True) As String
Dim ws As Worksheet
Dim NumI As Currency
Dim strZero As String, strPaisa As String, strPaise As String, strRupee As String, strRupees As String
Dim suffPaisa As String, suffPaise As String, suffRupee As String, suffRupees As String, suff As String
Dim Paise, Rupee
Dim decimalNum As Boolean
Dim r
If Num = 0 Then Exit Function
Set ws = Sheet2
strZero = ws.Range("F3").Value
suffPaisa = ws.Range("F2").Value
suffPaise = ws.Range("G2").Value
suffRupee = ws.Range("F1").Value
suffRupees = ws.Range("G1").Value
suff = ws.Range("F4").Value
'**************************************************************************
'Constructing string for Paise
'**************************************************************************
'Checking decimal part
If Num - Int(Num) <> 0 Then decimalNum = True
If decimalNum Then
Paise = Round(Num - Int(Num), 2)
Paise = Left(Paise * 100, 2) + 0
r = Application.Match(Paise, ws.Columns(1), 0)
strPaise = ws.Cells(r, "B")
Else
suffPaisa = ""
suffPaise = ""
End If
If Paise = 0 And ZeroPaise = True Then
strPaise = ws.Range("B2").Value & " " & ws.Range("G2").Value
ElseIf Paise = 0 And ZeroPaise = False Then
strPaise = ""
ElseIf Paise = 1 Then
strPaise = strPaise & " " & suffPaisa
Else
strPaise = strPaise & " " & suffPaise
End If
'**************************************************************************
'**************************************************************************
'Constructing string for Rupees
'**************************************************************************
'Checking integer part
'Check if Number is less than 100
If Int(Num) < 100 Then
r = Application.Match(Int(Num), ws.Columns(1), 0)
strRupees = ws.Cells(r, "B")
If Int(Num) = 0 Then
strRupees = ""
ElseIf Int(Num) = 1 Then
strRupees = strRupees & " " & suffRupee
Else
strRupees = strRupees & " " & suffRupees
End If
GoTo ConstructString
End If
'If number is equal to 100 or greater than 100
Dim Ten, Hundred, Thousand, Lacs, Crore, Arab
If Num = 100 Then
strRupees = ws.Range("D1").Value & " " & ws.Range("G1").Value
Else
NumI = WorksheetFunction.Quotient(Num, 1)
If Len(CStr(NumI)) > 9 Then
Arab = WorksheetFunction.Quotient(NumI, 1000000000)
NumI = NumI - (Arab * 1000000000)
End If
If Len(CStr(NumI)) > 7 Then
Crore = WorksheetFunction.Quotient(NumI, 10000000)
NumI = Int(NumI Mod 10000000)
End If
If Len(CStr(NumI)) > 5 Then
Lacs = WorksheetFunction.Quotient(NumI, 100000)
NumI = Int(NumI Mod 100000)
End If
If Len(CStr(NumI)) > 3 Then
Thousand = WorksheetFunction.Quotient(NumI, 1000)
NumI = Int(NumI Mod 1000)
End If
If Len(CStr(NumI)) > 2 Then
Hundred = WorksheetFunction.Quotient(NumI, 100)
NumI = Int(NumI Mod 100)
End If
Ten = NumI
If Arab > 0 Then strRupees = getRupeeStr(Arab) & " " & ws.Range("D5").Value
If Crore > 0 Then strRupees = strRupees & " " & getRupeeStr(Crore) & " " & ws.Range("D4").Value
If Lacs > 0 Then strRupees = strRupees & " " & getRupeeStr(Lacs) & " " & ws.Range("D3").Value
If Thousand > 0 Then strRupees = strRupees & " " & getRupeeStr(Thousand) & " " & ws.Range("D2").Value
If Hundred > 0 Then strRupees = strRupees & " " & getRupeeStr(Hundred) & " " & ws.Range("D1").Value
If Ten > 0 Then strRupees = strRupees & " " & getRupeeStr(Ten)
strRupees = strRupees & " " & ws.Range("G1").Value
End If
ConstructString:
NumberToWord = WorksheetFunction.Trim(strRupees & " " & strPaise & " " & suff)
NumI = 0
End Function
Function getRupeeStr(ByVal Num As Integer) As String
Dim ws As Worksheet
Dim r
Set ws = Sheet2
r = Application.Match(Num, ws.Columns(1), 0)
If Not IsError(r) Then getRupeeStr = ws.Cells(r, "B")
End Function
KIndly Please Help. to run in Access.