P
prkhan56
Hello All,
I am using Office 2003 and have the following problem
I got the following macro from the net which converts the digit to
words in MS Word
The macro works perfect but I wish to change it according to IRs
(Indian Rupees) for Dollars and Paise for Cents.
I tried to change it but did not succeed with my limited knowledge of
VBA
Can anybody help me with the changes in the following macro so that it
shows IRs instead of $ and Paise instead of Cents.
One more thing .. the macro convert the Numeric to Word and place the
Numeric in brackets at the end.
I wish to have it in the following format:
IRs 12,345.78 - IRs. Twelwe Thousand Three Hundred Forty Five and 78
paise
and not as
IRs. Twelwe Thousand Three Hundred Forty Five and 78 paise (IRs
12,345.78)
Any help would be greatly appreciated
TIA
Rashid Khan
Sub NumConv()
'
' NumConv Macro
'
'
Dim vOrigNum As String, vOrigNumPercent As String, vDollar As
Integer
Dim vPercent As Integer, vDecimal As Integer, vStrLeft As String
Dim vStrLeftLen As Integer, vStrRight As String, vStrRightLen As
Integer
Dim vStrChar As String, vStrHoldStr As String, vStrHoldStrLen As
Integer
Dim vStrLeftMil As String, vStrLeftBil As String
Dim vStrLeftThou As String, vSrrLeftHun As String
Dim vClearSpace As String
If Selection.Type = wdSelectionIP Then 'Selects numbers to left of
IP
Selection.MoveStartWhile Cset:="0123456789$%.,-",
Count:=wdBackward
End If
vOrigNum = Selection.Text 'Assigns selection to variable
vOrigNumLen = Len(vOrigNum) 'Sets length of selected number to
variable
vDollar = InStr(1, vOrigNum, "$") 'Checks to see if number is
dollar figure
vPercent = InStr(1, vOrigNum, "%") 'Checks to see if number is a
percent
vMinus = InStr(1, vOrigNum, "-") 'Checks to see if number is
negative
If vMinus <> 0 Then
If vDollar <> 0 Then 'If a dollar amount, then Caps; otherwise,
lowercase
Selection.TypeText Text:="Minus " 'Types Minus if no. is
negative
Else
Selection.TypeText Text:="minus " 'Types minus if no. is
negative
End If
End If
For i = 1 To vOrigNumLen 'Strips all but numbers from variable
vStrChar = Mid$(vOrigNum, i, 1)
Select Case vStrChar
Case ",", "$", "%", "-"
Case Else
vStrHoldStr = vStrHoldStr & vStrChar
End Select 'Stripped number assigned to new variable
Next i
vStrHoldStrLen = Len(vStrHoldStr) 'Checks length of stripped number
vDecimal = InStr(1, vStrHoldStr, ".") 'Checks to see if number
includes decimal
'If number includes decimal, assigns zeros if needed to the left or
right
If vDecimal <> 0 Then
vStrLeft = Mid(vStrHoldStr, 1, vDecimal - 1)
If vStrLeft = "" Then
vStrLeft = "0" 'Adds left zero for ".87" type number
End If
If vStrHoldStrLen - vDecimal = "0" Then
vStrRight = "0" 'Adds right zero for "87." type number
If vDollar <> 0 Then vStrRight = "00" 'Adds two zeros for
"$87." type number
Else
vStrRight = Mid(vStrHoldStr, vDecimal + 1, vStrHoldStrLen -
vDecimal)
End If 'Assigns actual numbers to vStrRight if they exist
End If
If vDecimal = 0 Then 'If there is no decimal, assigns number to
vStrLeft
vStrLeft = vStrHoldStr
vStrRight = "0" 'and adds 0 or 00, as appropriate, to vStrRight
If vDollar <> 0 Then vStrRight = "00"
End If
vStrLeftLen = Len(vStrLeft) 'Assigns length of vStrLeft to
vStrLeftLen
If vStrLeftLen > 12 Then GoTo GreaterThanBillion 'If > billion,
exit
'If billions, strip billions string and insert into doc using Field
If vStrLeftLen > 9 Then
'Start at position 1, move right Length - 9 positions
vStrLeftBil = Mid(vStrLeft, 1, vStrLeftLen - 9)
'Assign leftover string to vStrLeft, start at Length-8, move 9
positions
vStrLeft = Mid(vStrLeft, vStrLeftLen - 8, 9)
vStrLeftLen = Len(vStrLeft)
If vDollar <> 0 Then 'If a dollar amount, then Caps; otherwise,
lowercase
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, _
Text:="= " + vStrLeftBil + " \* CardText \* Caps", _
PreserveFormatting:=True
Selection.TypeText Text:=" Billion "
Else
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, _
Text:="= " + vStrLeftBil + " \* CardText", _
PreserveFormatting:=True
Selection.TypeText Text:=" billion "
End If
Else
GoTo CheckMillions 'If no billions, check millions
End If
CheckMillions:
'If millions, strip millions string and insert into doc using Field
If vStrLeftLen > 6 Then
'Start at position 1, move right Length - 6 positions
vStrLeftMil = Mid(vStrLeft, 1, vStrLeftLen - 6)
'Assign leftover string to vStrLeft, start Length-5, move 6
positions
vStrLeft = Mid(vStrLeft, vStrLeftLen - 5, 6)
vStrLeftLen = Len(vStrLeft)
'If there is no millions, go to thousands
If vStrLeftMil = "000" Then
GoTo DoThousands
End If
'If a dollar amount, then Caps; otherwise, lowercase
If vDollar <> 0 Then
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, _
Text:="= " + vStrLeftMil + " \* CardText \* Caps ", _
PreserveFormatting:=True
Selection.TypeText Text:=" Million "
Else
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, _
Text:="= " + vStrLeftMil + " \* CardText ", _
PreserveFormatting:=True
Selection.TypeText Text:=" million "
End If
Else
GoTo DoThousands 'If no millions, do hundred thousands
End If
DoThousands:
'If decimal, but not dollar, insert thousands, but skip if 0
If vDecimal <> 0 And vDollar = 0 And vStrLeft <> "000000" Then
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, _
Text:="= " + vStrLeft + " \* CardText", _
PreserveFormatting:=True 'Removed \* Caps to use lowercase
End If
'If decimal, but not dollar, insert left/right Fields using "point"
If vDecimal <> 0 And vDollar = 0 Then
vClearSpace = ClearExtraSpace() 'Deletes extra space in
"millions"
Selection.TypeText " point "
vStrRightLen = Len(vStrRight)
For i = 1 To vStrRightLen 'Individually insert each right side
number
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, _
Text:="= " + Mid(vStrRight, i, 1) + " \* CardText", _
PreserveFormatting:=True 'Removed \* Caps to use lowercase
Selection.TypeText Text:=" "
Next i
Selection.TypeBackspace
End If
'If not decimal, and not dollar, just insert Field for number words
If vDecimal = 0 And vDollar = 0 And vStrLeft <> "000000" Then
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, _
Text:="= " + vStrLeft + " \* CardText", _
PreserveFormatting:=True 'Removed *\ Caps to use lowercase
End If
'If percent, but not dollar, insert word "Percent"
If vPercent <> 0 And vDollar = 0 Then
vClearSpace = ClearExtraSpace() 'Deletes extra space in
"millions"
Selection.TypeText Text:=" percent"
End If
'If dollar, insert Fields for left/right numbers w/decimal point and
"Dollars"
If vDollar <> 0 Then
vStrRightLen = Len(vStrRight) 'Ensures decimal has only two
digits
If vStrRightLen > 2 Then
vStrRight = Mid(vStrRight, 1, 2) 'Strips excess digits
End If
'If left of decimal = 0, and right is no 00, insert "No
Dollars"
If vStrLeft = "0" Then
Selection.TypeText Text:="No Dollars"
Else
If vStrLeft = "1" Then 'If left of decimal = 1, insert
"One Dollar"
Selection.TypeText Text:="One Dollar"
Else 'Else insert the "dollars" using "CardText"
If vStrLeft <> "000000" Then
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, _
Text:="= " + vStrLeft + " \* CardText \* Caps",
_
PreserveFormatting:=True
Selection.TypeText Text:=" "
End If
Selection.TypeText Text:="Dollars" 'Insert words after
numbers
End If
End If
If vStrRight <> "00" Then 'If right of the decimal is not 00,
insert cents
Selection.TypeText Text:=" and " 'Insert "and" before
decimal numbers
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, _
Text:="= " + vStrRight + " \* CardText \* Caps", _
PreserveFormatting:=True
If vStrRight = "01" Then
Selection.TypeText Text:=" Cent" 'Insert "Cent" for
"One Cent"
Else
Selection.TypeText Text:=" Cents" 'Insert "Cents" for
other "cents"
End If
Else
Selection.TypeText Text:=" and No Cents" 'Insert "No
Cents" if 0 cents
End If
End If
vClearSpace = ClearExtraSpace() 'Deletes extra space in "millions"
Selection.TypeText Text:=" (" 'Type parenthesis and actual number
into doc
If vMinus <> 0 Then Selection.TypeText Text:="-" 'Add minus symbol
If vDollar <> 0 Then Selection.TypeText Text:="$" 'Add dollar
symbol
'Type billions and millions followed by comma
If vStrLeftBil <> "" Then Selection.TypeText Text:=vStrLeftBil +
","
If vStrLeftMil <> "" Then Selection.TypeText Text:=vStrLeftMil +
","
If vStrLeftLen > 3 Then 'Insert hundred thousands with comma
vStrLeftThou = Mid(vStrLeft, 1, vStrLeftLen - 3)
vStrLeft = Mid(vStrLeft, vStrLeftLen - 2, 3)
Selection.TypeText Text:=vStrLeftThou + ","
End If
Selection.TypeText Text:=vStrLeft 'Insert remaining hundreds
'Add decimal point if vDecimal or vDollar is true
If vDecimal <> 0 Or vDollar <> 0 Then Selection.TypeText Text:="."
Selection.TypeText Text:=vStrRight 'Insert right side string
'Remove trailing 0 if vDecimal is 0 (assigned in first routine
above
'to assign vStrLeft & vStrRight
If vDecimal = 0 And vStrRight = "0" Then Selection.TypeBackspace
If vPercent <> 0 Then Selection.TypeText Text:="%" 'Add percent
symbol
Selection.TypeText Text:=")" 'Insert closing parenthesis
GoTo SkipErrorMsg 'Jumps over GreatThanBillion error message
GreaterThanBillion: 'GreaterThanBillion error message
ret = MsgBox("Number is Greater than 999,999,999,999.99!" + vbCr +
_
"Macro will now terminate.", vbOKOnly + vbExclamation, "NumConv
Macro Error!")
SkipErrorMsg: 'Ends macro
End Sub
Function ClearExtraSpace()
'Deletes extra space when "million " used in some cases
If Selection.Characters.First.Previous = " " Then
Selection.TypeBackspace
End If
End Function
I am using Office 2003 and have the following problem
I got the following macro from the net which converts the digit to
words in MS Word
The macro works perfect but I wish to change it according to IRs
(Indian Rupees) for Dollars and Paise for Cents.
I tried to change it but did not succeed with my limited knowledge of
VBA
Can anybody help me with the changes in the following macro so that it
shows IRs instead of $ and Paise instead of Cents.
One more thing .. the macro convert the Numeric to Word and place the
Numeric in brackets at the end.
I wish to have it in the following format:
IRs 12,345.78 - IRs. Twelwe Thousand Three Hundred Forty Five and 78
paise
and not as
IRs. Twelwe Thousand Three Hundred Forty Five and 78 paise (IRs
12,345.78)
Any help would be greatly appreciated
TIA
Rashid Khan
Sub NumConv()
'
' NumConv Macro
'
'
Dim vOrigNum As String, vOrigNumPercent As String, vDollar As
Integer
Dim vPercent As Integer, vDecimal As Integer, vStrLeft As String
Dim vStrLeftLen As Integer, vStrRight As String, vStrRightLen As
Integer
Dim vStrChar As String, vStrHoldStr As String, vStrHoldStrLen As
Integer
Dim vStrLeftMil As String, vStrLeftBil As String
Dim vStrLeftThou As String, vSrrLeftHun As String
Dim vClearSpace As String
If Selection.Type = wdSelectionIP Then 'Selects numbers to left of
IP
Selection.MoveStartWhile Cset:="0123456789$%.,-",
Count:=wdBackward
End If
vOrigNum = Selection.Text 'Assigns selection to variable
vOrigNumLen = Len(vOrigNum) 'Sets length of selected number to
variable
vDollar = InStr(1, vOrigNum, "$") 'Checks to see if number is
dollar figure
vPercent = InStr(1, vOrigNum, "%") 'Checks to see if number is a
percent
vMinus = InStr(1, vOrigNum, "-") 'Checks to see if number is
negative
If vMinus <> 0 Then
If vDollar <> 0 Then 'If a dollar amount, then Caps; otherwise,
lowercase
Selection.TypeText Text:="Minus " 'Types Minus if no. is
negative
Else
Selection.TypeText Text:="minus " 'Types minus if no. is
negative
End If
End If
For i = 1 To vOrigNumLen 'Strips all but numbers from variable
vStrChar = Mid$(vOrigNum, i, 1)
Select Case vStrChar
Case ",", "$", "%", "-"
Case Else
vStrHoldStr = vStrHoldStr & vStrChar
End Select 'Stripped number assigned to new variable
Next i
vStrHoldStrLen = Len(vStrHoldStr) 'Checks length of stripped number
vDecimal = InStr(1, vStrHoldStr, ".") 'Checks to see if number
includes decimal
'If number includes decimal, assigns zeros if needed to the left or
right
If vDecimal <> 0 Then
vStrLeft = Mid(vStrHoldStr, 1, vDecimal - 1)
If vStrLeft = "" Then
vStrLeft = "0" 'Adds left zero for ".87" type number
End If
If vStrHoldStrLen - vDecimal = "0" Then
vStrRight = "0" 'Adds right zero for "87." type number
If vDollar <> 0 Then vStrRight = "00" 'Adds two zeros for
"$87." type number
Else
vStrRight = Mid(vStrHoldStr, vDecimal + 1, vStrHoldStrLen -
vDecimal)
End If 'Assigns actual numbers to vStrRight if they exist
End If
If vDecimal = 0 Then 'If there is no decimal, assigns number to
vStrLeft
vStrLeft = vStrHoldStr
vStrRight = "0" 'and adds 0 or 00, as appropriate, to vStrRight
If vDollar <> 0 Then vStrRight = "00"
End If
vStrLeftLen = Len(vStrLeft) 'Assigns length of vStrLeft to
vStrLeftLen
If vStrLeftLen > 12 Then GoTo GreaterThanBillion 'If > billion,
exit
'If billions, strip billions string and insert into doc using Field
If vStrLeftLen > 9 Then
'Start at position 1, move right Length - 9 positions
vStrLeftBil = Mid(vStrLeft, 1, vStrLeftLen - 9)
'Assign leftover string to vStrLeft, start at Length-8, move 9
positions
vStrLeft = Mid(vStrLeft, vStrLeftLen - 8, 9)
vStrLeftLen = Len(vStrLeft)
If vDollar <> 0 Then 'If a dollar amount, then Caps; otherwise,
lowercase
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, _
Text:="= " + vStrLeftBil + " \* CardText \* Caps", _
PreserveFormatting:=True
Selection.TypeText Text:=" Billion "
Else
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, _
Text:="= " + vStrLeftBil + " \* CardText", _
PreserveFormatting:=True
Selection.TypeText Text:=" billion "
End If
Else
GoTo CheckMillions 'If no billions, check millions
End If
CheckMillions:
'If millions, strip millions string and insert into doc using Field
If vStrLeftLen > 6 Then
'Start at position 1, move right Length - 6 positions
vStrLeftMil = Mid(vStrLeft, 1, vStrLeftLen - 6)
'Assign leftover string to vStrLeft, start Length-5, move 6
positions
vStrLeft = Mid(vStrLeft, vStrLeftLen - 5, 6)
vStrLeftLen = Len(vStrLeft)
'If there is no millions, go to thousands
If vStrLeftMil = "000" Then
GoTo DoThousands
End If
'If a dollar amount, then Caps; otherwise, lowercase
If vDollar <> 0 Then
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, _
Text:="= " + vStrLeftMil + " \* CardText \* Caps ", _
PreserveFormatting:=True
Selection.TypeText Text:=" Million "
Else
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, _
Text:="= " + vStrLeftMil + " \* CardText ", _
PreserveFormatting:=True
Selection.TypeText Text:=" million "
End If
Else
GoTo DoThousands 'If no millions, do hundred thousands
End If
DoThousands:
'If decimal, but not dollar, insert thousands, but skip if 0
If vDecimal <> 0 And vDollar = 0 And vStrLeft <> "000000" Then
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, _
Text:="= " + vStrLeft + " \* CardText", _
PreserveFormatting:=True 'Removed \* Caps to use lowercase
End If
'If decimal, but not dollar, insert left/right Fields using "point"
If vDecimal <> 0 And vDollar = 0 Then
vClearSpace = ClearExtraSpace() 'Deletes extra space in
"millions"
Selection.TypeText " point "
vStrRightLen = Len(vStrRight)
For i = 1 To vStrRightLen 'Individually insert each right side
number
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, _
Text:="= " + Mid(vStrRight, i, 1) + " \* CardText", _
PreserveFormatting:=True 'Removed \* Caps to use lowercase
Selection.TypeText Text:=" "
Next i
Selection.TypeBackspace
End If
'If not decimal, and not dollar, just insert Field for number words
If vDecimal = 0 And vDollar = 0 And vStrLeft <> "000000" Then
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, _
Text:="= " + vStrLeft + " \* CardText", _
PreserveFormatting:=True 'Removed *\ Caps to use lowercase
End If
'If percent, but not dollar, insert word "Percent"
If vPercent <> 0 And vDollar = 0 Then
vClearSpace = ClearExtraSpace() 'Deletes extra space in
"millions"
Selection.TypeText Text:=" percent"
End If
'If dollar, insert Fields for left/right numbers w/decimal point and
"Dollars"
If vDollar <> 0 Then
vStrRightLen = Len(vStrRight) 'Ensures decimal has only two
digits
If vStrRightLen > 2 Then
vStrRight = Mid(vStrRight, 1, 2) 'Strips excess digits
End If
'If left of decimal = 0, and right is no 00, insert "No
Dollars"
If vStrLeft = "0" Then
Selection.TypeText Text:="No Dollars"
Else
If vStrLeft = "1" Then 'If left of decimal = 1, insert
"One Dollar"
Selection.TypeText Text:="One Dollar"
Else 'Else insert the "dollars" using "CardText"
If vStrLeft <> "000000" Then
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, _
Text:="= " + vStrLeft + " \* CardText \* Caps",
_
PreserveFormatting:=True
Selection.TypeText Text:=" "
End If
Selection.TypeText Text:="Dollars" 'Insert words after
numbers
End If
End If
If vStrRight <> "00" Then 'If right of the decimal is not 00,
insert cents
Selection.TypeText Text:=" and " 'Insert "and" before
decimal numbers
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, _
Text:="= " + vStrRight + " \* CardText \* Caps", _
PreserveFormatting:=True
If vStrRight = "01" Then
Selection.TypeText Text:=" Cent" 'Insert "Cent" for
"One Cent"
Else
Selection.TypeText Text:=" Cents" 'Insert "Cents" for
other "cents"
End If
Else
Selection.TypeText Text:=" and No Cents" 'Insert "No
Cents" if 0 cents
End If
End If
vClearSpace = ClearExtraSpace() 'Deletes extra space in "millions"
Selection.TypeText Text:=" (" 'Type parenthesis and actual number
into doc
If vMinus <> 0 Then Selection.TypeText Text:="-" 'Add minus symbol
If vDollar <> 0 Then Selection.TypeText Text:="$" 'Add dollar
symbol
'Type billions and millions followed by comma
If vStrLeftBil <> "" Then Selection.TypeText Text:=vStrLeftBil +
","
If vStrLeftMil <> "" Then Selection.TypeText Text:=vStrLeftMil +
","
If vStrLeftLen > 3 Then 'Insert hundred thousands with comma
vStrLeftThou = Mid(vStrLeft, 1, vStrLeftLen - 3)
vStrLeft = Mid(vStrLeft, vStrLeftLen - 2, 3)
Selection.TypeText Text:=vStrLeftThou + ","
End If
Selection.TypeText Text:=vStrLeft 'Insert remaining hundreds
'Add decimal point if vDecimal or vDollar is true
If vDecimal <> 0 Or vDollar <> 0 Then Selection.TypeText Text:="."
Selection.TypeText Text:=vStrRight 'Insert right side string
'Remove trailing 0 if vDecimal is 0 (assigned in first routine
above
'to assign vStrLeft & vStrRight
If vDecimal = 0 And vStrRight = "0" Then Selection.TypeBackspace
If vPercent <> 0 Then Selection.TypeText Text:="%" 'Add percent
symbol
Selection.TypeText Text:=")" 'Insert closing parenthesis
GoTo SkipErrorMsg 'Jumps over GreatThanBillion error message
GreaterThanBillion: 'GreaterThanBillion error message
ret = MsgBox("Number is Greater than 999,999,999,999.99!" + vbCr +
_
"Macro will now terminate.", vbOKOnly + vbExclamation, "NumConv
Macro Error!")
SkipErrorMsg: 'Ends macro
End Sub
Function ClearExtraSpace()
'Deletes extra space when "million " used in some cases
If Selection.Characters.First.Previous = " " Then
Selection.TypeBackspace
End If
End Function