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 Function

e.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!!