Programmatic access to Visual Basic ProJect is not Trusted

When VBE Command is Correct But...
See Err' Message in Excel VBE(VBA)
"Programmatic access to Visual Basic ProJect is not trusted"

This Capture When Error

1. Close VBE indow And Change Tools Option 2. Secyrity Select 3. Check Trust Access to VB ProJect

Convert Number to TEXT (UDF NUM2DOLLAR97)

   Hi ! Here Suggest to you

[ Convert Number to DOLLAR (UDF NUM2DOLLAR97) ] Let's Look & Find    --->     You Can Convert Number to DOLLAR     Sample - 1 NUM2DOLLAR97 (Number)     Default Money Display = Dollar(s)     Sample - 2 NUM2DOLLAR97 (Number, "fran")

1  2  3  4  5  6  7  8  9  10  11  12  13  14  15  16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31  32  33  34  35

A B 1 One Dollar. 109 One Hundred Nine Dollars. 218 Two Hundred Eighteen Dollars. 326 Three Hundred Twenty Six Dollars. 435 Four Hundred Thirty Five Dollars. 1,443 One Thousand Four Hundred Forty Three Dollars. 2,452 Two Thousand Four Hundred Fifty Two Dollars. 12,460 Twelve Thousand Four Hundred Sixty Dollars. 22,469 Twenty Two Thousand Four Hundred Sixty Nine Dollars. 30,000 Thirty Thousand Dollars. 30,003 Thirty Thousand Three Dollars. 40,000 Forty Thousand Dollars. 50,009 Fifty Thousand Nine Dollars. 7,000,015 Seven Million Fifteen Dollars. 7,001,015 Seven Million One Thousand Fifteen Dollars. 1 One Dollar. 109.01 One Hundred Nine Dollars and One Cents. 218.02 Two Hundred Eighteen Dollars and Two Cents. 326.08 Three Hundred Twenty Six Dollars and Eight Cents. 435.09 Four Hundred Thirty Five Dollars and Nine Cents. 1,043.10 One Thousand Forty Three Dollars and Ten Cents. 2,052.91 Two Thousand Fifty Two Dollars and Ninety One Cents. 12,060.00 Twelve Thousand Sixty Dollars. 22,069.01 Twenty Two Thousand Sixty Nine Dollars and One Cents. 30,010.02 Thirty Thousand Ten Dollars and Two Cents. 30,013.08 Thirty Thousand Thirteen Dollars and Eight Cents. 7,001,005.11 Seven Million One Thousand Five Dollars and Eleven Cents. 7,001,015.11 Seven Million One Thousand Fifteen Dollars and Eleven Cents. 102.1333 One Hundred Two Dollars and Thirteen Cents and Three Three. 102.2536 One Hundred Two Dollars and Twenty Five Cents and Three Six. 102.9042 One Hundred Two Dollars and Ninety Cents and Four Two. 110.1351 One Hundred Ten Dollars and Thirteen Cents and Five One. 200.1354 Two Hundred Dollars and Thirteen Cents and Five Four. 1 One franc. 109 One Hundred Nine franc's.

Used Formula ...(With Running MicrosoftExcel Ver 97)
No	Addr'	If use below Formula, You'll Get Result as Right	Result	Etc
1	B1	=NUM2DOLLAR97(A1)	One Dollar.
2		B1  His Formula Used This Cell  -> B1:B33
3	B34	=NUM2DOLLAR97(A34,"franc")	One franc.
4		B34  His Formula Used This Cell  -> B34:B35
How about this suggest?

Function NUM2DOLLAR97(WhatsNumber As Double, Optional MoneyType As String = "Dollar")
Dim iLoop As Integer               'Loop
Dim CommaNumbr(1 To 5) As String   'Share by 3 Digit
Dim StrngNum_1 As String           'String Number to Format 000 000...
Dim StrngNum_2 As String           'String Number of Decimal
Dim WorkNumber As Variant          '000 000... Split
Dim NumInt     As String           'Number Integer
Dim NumDec     As String           'Decimal Number
Dim PosDot     As Integer
Dim PosDec     As Integer
Dim DecCent    As String

On Error Resume Next
     CommaNumbr(1) = " Trillion ": CommaNumbr(2) = " Billion "
     CommaNumbr(3) = " Million ":  CommaNumbr(4) = " Thousand "
     
PosDot = InStr(WhatsNumber, ".")

If WhatsNumber = 0 Then
          NUM2DOLLAR97 = "No Dollar."
     If MoneyType <> "Dollar" Then
          NUM2DOLLAR97 = Replace97(NUM2DOLLAR97, "Dollar", MoneyType)
     End If
          Exit Function
ElseIf WhatsNumber = 1 Then
          NUM2DOLLAR97 = "One Dollar."
     If MoneyType <> "Dollar" Then
          NUM2DOLLAR97 = Replace97(NUM2DOLLAR97, "Dollar", MoneyType)
     End If
          Exit Function

End If

If PosDot = 0 Then
     StrngNum_1 = Format(WhatsNumber, " 000 000 000 000 000")
Else
     StrngNum_1 = Format(Left(WhatsNumber, PosDot - 1), " 000 000 000 000 000")
     StrngNum_2 = Mid(WhatsNumber, PosDot + 1)
     PosDec = Len(StrngNum_2)
End If
     WorkNumber = Split97(StrngNum_1, " ")

For iLoop = 1 To UBound(WorkNumber)
     If WorkNumber(iLoop) <> "000" Then
     NumInt = NumInt & String_1(Left(WorkNumber(iLoop), 1))
     NumInt = NumInt & String_2(Right(WorkNumber(iLoop), 2)) & CommaNumbr(iLoop)
     End If
Next

If NumInt = "" Then
     NumInt = "Zero Dollar"
Else
     NumInt = NumInt & " Dollars "
End If

     If PosDot = 0 Then
          NUM2DOLLAR97 = NumInt
     Else
          If PosDec = 1 Then
                    NUM2DOLLAR97 = NumInt & " and " & String_2(StrngNum_2 & "0") & " Cents "
          ElseIf PosDec = 2 Then
                    NUM2DOLLAR97 = NumInt & " and " & String_2(StrngNum_2) & " Cents "
          Else
               DecCent = Left(StrngNum_2, 2)
               If DecCent = "00" Then
                    NumDec = String_2(DecCent) & " NoCent "
               Else
                    NumDec = String_2(DecCent) & " Cents and"
               End If
               For iLoop = 3 To PosDec
                    If Mid(StrngNum_2, iLoop, 1) = "0" Then
                    NumDec = NumDec & " Zero"
                    Else
                    NumDec = NumDec & " " & String_3(Mid(StrngNum_2, iLoop, 1))
                    End If
               Next
                    NumDec = NumDec & " "
                    NUM2DOLLAR97 = NumInt & " and " & NumDec
          End If
     End If
     
     NUM2DOLLAR97 = RTrim(Replace97(NUM2DOLLAR97, "  ", " "))
If MoneyType <> "Dollar" Then
     NUM2DOLLAR97 = Replace97(NUM2DOLLAR97, "Dollar", MoneyType & "'")
     'If Want "francs" Instead of "franc's" then
     'Use This
     'NUM2DOLLAR97 = Replace(NUM2DOLLAR97, "Dollar", MoneyType)
End If
     NUM2DOLLAR97 = NUM2DOLLAR97 & "."
End Function

Function String_1(MyString As String)   ' 100's Number
If MyString <> "0" Then
     String_1 = String_3(MyString) & " Hundred "
End If
End Function

Function String_2(MyString As String)   ' 10's Number (20-90)
Select Case Left(MyString, 1)
     Case "1"
          String_2 = String_21(MyString)
          Exit Function
     Case "2": String_2 = "Twenty ":    Case "3": String_2 = "Thirty "
     Case "4": String_2 = "Forty ":     Case "5": String_2 = "Fifty "
     Case "6": String_2 = "Sixty ":     Case "7": String_2 = "Seventy "
     Case "8": String_2 = "Eighty ":    Case "9": String_2 = "Ninety "
End Select
          String_2 = String_2 & String_3(Right(MyString, 1))
End Function

Function String_21(MyString As String)  ' 10-19's Number
Select Case MyString
     Case "10": String_21 = "Ten":      Case "11": String_21 = "Eleven"
     Case "12": String_21 = "Twelve":   Case "13": String_21 = "Thirteen"
     Case "14": String_21 = "Fourteen": Case "15": String_21 = "Fifteen"
     Case "16": String_21 = "Sixteen":  Case "17": String_21 = "Seventeen"
     Case "18": String_21 = "Eighteen": Case "19": String_21 = "Nineteen"
End Select
End Function

Function String_3(MyString As String)   ' 1-9's Number
Select Case MyString
     Case "1": String_3 = "One":        Case "2": String_3 = "Two"
     Case "3": String_3 = "Three":      Case "4": String_3 = "Four"
     Case "5": String_3 = "Five":       Case "6": String_3 = "Six"
     Case "7": String_3 = "Seven":      Case "8": String_3 = "Eight"
     Case "9": String_3 = "Nine"
End Select
End Function

Function Split97(OriStr, Optional OptStr As String = ",")
Dim GetText    As String
Dim GetPoss    As Double
Dim MidStr     As Variant
Dim AnsStr     As Variant
ReDim MidStr(0 To Len(CStr(OriStr)))
Dim i As Double, j As Double
GetText = OriStr
For i = 1 To Len(CStr(OriStr))
GetPoss = InStr(GetText, OptStr)
     If GetPoss > 0 Then
          MidStr(j) = Left(GetText, GetPoss - 1)
          GetText = Mid(GetText, GetPoss + 1)
          j = j + 1
     Else
          MidStr(j) = Mid(GetText, GetPoss + 1)
          Exit For
     End If
Next
ReDim AnsStr(0 To j)
For i = 0 To j
     AnsStr(i) = MidStr(i)
Next
Split97 = AnsStr
End Function

Function Replace97(OriStr As Variant, _
               Str1 As String, Str2 As String, _
               Optional Pos As Double = 1)
Dim i9 As Double
Dim Fn As WorksheetFunction
Set Fn = Application.WorksheetFunction
If Pos = 1 Then
    Replace97 = Fn.Substitute(OriStr, Str1, Str2)
Else
Replace97 = OriStr
    For i9 = Pos To Len(OriStr)
    Replace97 = Fn.Substitute(Replace97, Str1, Str2, i9)
    Next
End If
End Function

Any Bug Or Ask ... Mail Or Post Reply