HELP!!

[Prashanth_r]

Hi,
My requirement is to convert all the figures entered into words as Indian Currency when the macro is run. I face issues at 3 places -
1.The first row digits are not converted
2.If I enter '0' it is not getting converted to zero
3.The number after decimal point is not getting converted.






Public Sub ParseDoc()


Dim strFind As String
Dim length As Integer
Dim inrStart As Integer


For Each sentence In ActiveDocument.StoryRanges
For Each w In sentence.Words
strFind = w.Text
inrStart = InStr(strFind, "INR")
If inrStart = 1 Then
length = Len(w.Text) - 3
strFind = Right(strFind, length)
With w.Find
.Text = strFind
.Replacement.Text = ConvertToNumeric(strFind)
.Execute Replace:=Word.WdReplace.wdReplaceAll
End With
End If
Next
Next
End Sub


Private Function ConvertToNumeric(ByVal amount)
MyNumber = Val(amount)

Dim Temp
Dim Rupees, Paise
Dim DecimalPlace, Count

ReDim place(9) As String
place(2) = " Thousand "
place(3) = " lakh "
place(4) = " Crore "


' Convert MyNumber to a string, trimming extra spaces.
MyNumber = Trim(Str(MyNumber))
' Find decimal place.
DecimalPlace = InStr(MyNumber, ".")

' If we find decimal place...
If DecimalPlace > 0 Then
' Convert Paise
Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
' Hi! Note the above line Mid function it gives right portion
' after the decimal point
'if only . and no numbers such as 789. accures, mid returns nothing
' to avoid error we added 00
' Left function gives only left portion of the string with specified places here 2


Paise = ConvertTens(Temp)


' Strip off paise from remainder to convert.
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If

Count = 1
If MyNumber <> "" Then

' Convert last 3 digits of MyNumber to Indian Rupees.
Temp = ConvertHundreds(Right(MyNumber, 3))

If Temp <> "" Then Rupees = Temp & place(Count) & Rupees

If Len(MyNumber) > 3 Then
' Remove last 3 converted digits from MyNumber.
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If

End If

' convert last two digits to of mynumber
Count = 2

Do While MyNumber <> ""
Temp = ConvertTens(Right("0" & MyNumber, 2))

If Temp <> "" Then Rupees = Temp & place(Count) & Rupees
If Len(MyNumber) > 2 Then
' Remove last 2 converted digits from MyNumber.
MyNumber = Left(MyNumber, Len(MyNumber) - 2)

Else
MyNumber = ""
End If
Count = Count + 1

Loop

' Clean up rupees.
Select Case Rupees
Case ""
Rupees = ""
Case "One"
Rupees = "One Rupee"
Case Else
Rupees = Rupees & " Rupees"
End Select

' Clean up paise.
Select Case Paise
Case ""
Paise = ""
Case "One"
Paise = "One Paise"
Case Else
Paise = Paise & " Paise"
End Select

If Rupees = "" Then
Result = Paise
ElseIf Paise = "" Then
Result = Rupees
Else
Result = Rupees & " and " & Paise
End If
ConvertToNumeric = Val(amount) & "/- ( " & Result & " Only) "
Debug.Print ConvertToNumeric
End Function


Private Function ConvertDigit(ByVal MyDigit)
Select Case Val(MyDigit)
Case 0: ConvertDigit = "Zero"
Case 1: ConvertDigit = "One"
Case 2: ConvertDigit = "Two"
Case 3: ConvertDigit = "Three"
Case 4: ConvertDigit = "Four"
Case 5: ConvertDigit = "Five"
Case 6: ConvertDigit = "Six"
Case 7: ConvertDigit = "Seven"
Case 8: ConvertDigit = "Eight"
Case 9: ConvertDigit = "Nine"
Case Else: ConvertDigit = ""
End Select

End Function

Private Function ConvertHundreds(ByVal MyNumber)
Dim Result As String

' Exit if there is nothing to convert.
If Val(MyNumber) = 0 Then Exit Function

' Append leading zeros to number.
MyNumber = Right("000" & MyNumber, 3)

' Do we have a hundreds place digit to convert?
If Left(MyNumber, 1) <> "0" Then
Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred and "
End If

' Do we have a tens place digit to convert?
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & ConvertTens(Mid(MyNumber, 2))
Else
' If not, then convert the ones place digit.
Result = Result & ConvertDigit(Mid(MyNumber, 3))
End If

ConvertHundreds = Trim(Result)
End Function


Private Function ConvertTens(ByVal MyTens)
Dim Result As String

' Is value between 10 and 19?
If Val(Left(MyTens, 1)) = 1 Then
Select Case Val(MyTens)
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
' .. otherwise it's between 20 and 99.
Select Case Val(Left(MyTens, 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

' Convert ones place digit.
Result = Result & ConvertDigit(Right(MyTens, 1))
End If

ConvertTens = Result
End Function

[gmayor]

Provide you tell the function which string to process, the following function will extract the numbers from the string


Private Function ExtractDigits(strText As String) As String
'Graham Mayor - http://www.gmayor.com - 24/09/2016
Dim i As Integer
ExtractDigits = ""
For i = 1 To Len(strText)
If Mid(strText, i, 1) >= "0" And _
Mid(strText, i, 1) <= "9" Or _
Mid(strText, i, 1) = "." Then
ExtractDigits = ExtractDigits + Mid(strText, i, 1)
End If
Next
lbl_Exit:
Exit Function
End Functione.g. in your document the numbers to be converted are in fields, so


Sub Macro1()
'Graham Mayor - http://www.gmayor.com - 24/09/2016
Dim oFld As Field
Dim oPara As Paragraph
Dim sNumber As String
On Error GoTo lbl_Exit
For Each oPara In ActiveDocument.Paragraphs
Set oFld = oPara.Range.Fields(1)
sNumber = ExtractDigits(oFld.Result)
If Len(sNumber) > 0 Then MsgBox (sNumber)
Next oPara
lbl_Exit:
Exit Sub
End Sub

[Prashanth_r]

Thanks a ton!!