Sayıları Dolar Biçiminde Yazdırma

Function DollarText(vNumber) As Variant
Dim sDollars As String
Dim sCents As String
Dim iLen As Integer
Dim sTemp As String
Dim iPos As Integer
Dim iHundreds As Integer
Dim iTens As Integer
Dim iOnes As Integer
Dim sUnits(2 To 5) As String
Dim bHit As Boolean
Dim vOnes As Variant
Dim vTeens As Variant
Dim vTens As Variant

If Not IsNumeric(vNumber) Then
    Exit Function
End If
sDollars = Format(vNumber, "###0.00")
iLen = Len(sDollars) - 3
If iLen > 15 Then
    DollarText = CVErr(xlErrNum)
    Exit Function
End If
sCents = Right$(sDollars, 2) & "/100 Dollars"
If vNumber < 1 Then
    DollarText = sCents
    Exit Function
End If

sDollars = Left$(sDollars, iLen)
vOnes = Array("", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine")
vTeens = Array("Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", "Eighteen", "Nineteen")
vTens = Array("", "", "Twenty", "Thirty", "Forty", "Fifty", "Sixty", "Seventy", "Eighty", "Ninety")
sUnits(2) = "Thousand"
sUnits(3) = "Million"
sUnits(4) = "Billion"
sUnits(5) = "Trillion"
sTemp = ""

For iPos = 15 To 3 Step -3
    If iLen >= iPos - 2 Then
  bHit = False
  If iLen >= iPos Then
iHundreds = Asc(Mid$(sDollars, iLen - iPos + 1, 1)) - 48
If iHundreds > 0 Then
    sTemp = sTemp & " " & vOnes(iHundreds) & ""
    Hundred ""
    bHit = True
End If
  End If
  iTens = 0
  iOnes = 0
  If iLen >= iPos - 1 Then
iTens = Asc(Mid$(sDollars, iLen - iPos + 2, 1)) - 48
  End If
  If iLen >= iPos - 2 Then
iOnes = Asc(Mid$(sDollars, iLen - iPos + 3, 1)) - 48
  End If
  If iTens = 1 Then
sTemp = sTemp & " " & vTeens(iOnes)
bHit = True
  Else
If iTens >= 2 Then
    sTemp = sTemp & " " & vTens(iTens)
    bHit = True
End If
If iOnes > 0 Then
    If iTens >= 2 Then
  sTemp = sTemp & "-"
    Else
  sTemp = sTemp & " "
    End If
    sTemp = sTemp & vOnes(iOnes)
    bHit = True
End If
  End If
  If bHit And iPos > 3 Then
    sTemp = sTemp & " " & sUnits(iPos \ 3)
    End If
End If
Next iPos
DollarText = Trim(sTemp) & " and " & sCents
End Function

=DollarText(B3)