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

Sheet2Web How to Easy Sheet Data Post 2.2

When Post Excel Sheet data to web / Html
for advice to other man or post your blog...
this tool should Useful
if Use stay this file on your Excel folder
XLStart or Library folder.

folder 1 : C:\Program Files\Microsoft Office\Office\XLStart
folder 2 : C:\Program Files\Microsoft Office\Office\Library

2008.10.01 New Tool Add And bug removed

Click to DownLoad Here ->> DownLoad XLA file or Zip file

Remove Some Bug	Add ColumnWidth AdJust

Convert Number to TEXT (UDF NUM2DOLLAR)

   Hi ! Here Suggest to you

[ Convert Number to DOLLAR (UDF NUM2DOLLAR) ] Let's Look & Find    --->    You Can Convert Number to DOLLAR    Sample - 1 NUM2DOLLAR (Number)    Default Money Display = Dollar(s)    Sample - 2 NUM2DOLLAR (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.00 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 2003)
No	Addr'	If use below Formula, You'll Get Result as Right	Result	Etc
1	B1	=NUM2DOLLAR(A1)	One Dollar.
2		B1  His Formula Used This Cell  -> B1:B33
3	B34	=NUM2DOLLAR(A34,"franc")	One franc.
4		B34  His Formula Used This Cell  -> B34:B35
How about this suggest?

Option Explicit

Function NUM2DOLLAR(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
          NUM2DOLLAR = "No Dollar."
     If MoneyType <> "Dollar" Then
          NUM2DOLLAR = Replace(NUM2DOLLAR, "Dollar", MoneyType)
     End If
          Exit Function
ElseIf WhatsNumber = 1 Then
          NUM2DOLLAR = "One Dollar."
     If MoneyType <> "Dollar" Then
          NUM2DOLLAR = Replace(NUM2DOLLAR, "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 = Split(StrngNum_1)

For iLoop = 1 To UBound(WorkNumber)
     If WorkNumber(iLoop) <> "000" Then
     NumInt = NumInt & String_1(Left(WorkNumber(iLoop), 1)) & 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
          NUM2DOLLAR = NumInt
     Else
          If PosDec = 1 Then
                    NUM2DOLLAR = NumInt & " and " & String_2(StrngNum_2 & "0") & " Cents "
          ElseIf PosDec = 2 Then
                    NUM2DOLLAR = 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 & " "
                    NUM2DOLLAR = NumInt & " and " & NumDec
          End If
     End If
     
     NUM2DOLLAR = RTrim(Replace(NUM2DOLLAR, "  ", " "))
If MoneyType <> "Dollar" Then
     NUM2DOLLAR = Replace(NUM2DOLLAR, "Dollar", MoneyType & "'")
     'If Want "francs" Instead of "franc's" then
     'Use This
     'NUM2Dollar = Replace(NUM2Dollar, "Dollar", MoneyType)
End If
     NUM2DOLLAR = NUM2DOLLAR & "."
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
Any Bug Or Ask ... Mail Or Post Reply

How Multi Range CONCATENATE (UDF STRJOIN)

   Hi ! Here Suggest to you

[ Multi Range CONCATENATE ] Let's Look & Find    --->    Use - 1 STRJOIN (text1,text2,...)    Default JoinString = ,    Use - 2 STRJOIN (text1,text2,.... JoinString)

21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36  37

A B C D E A Dec/31/2008 / B 0.12   C F   D           A,Dec/31/2008,/,B,0.12,C,F,D        Join With "," Default String A,Dec/31/2008,/,B,C,D        Join With "," Default String A,Dec/31/2008,B,0.12,D,/        Join With "," Default String A/Dec/31/2008/B/0.12/D        Join With "/" User String A Dec/31/2008 B 0.12 D        Join With " " User String A , Dec/31/2008 , B , 0.12 , D        Join With " , " User String

Used Formula ...(With Running MicrosoftExcel Ver 2003)
No	Addr'	If use below Formula, You'll Get Result as Right	Result	Etc
1	A26	=STRJOIN(A21:E24)	A,Dec/31/2008,/,B,0.12,C,F,D
2	A28	=STRJOIN(21:21,A22:A24)	A,Dec/31/2008,/,B,C,D
3	A30	=STRJOIN(A21:C22,A24,E21)	A,Dec/31/2008,B,0.12,D,/
4	A32	=STRJOIN(A21:C22,A24,TEXT(E21,"#"))	A/Dec/31/2008/B/0.12/D
5	A34	=STRJOIN(A21:C22,A24," ")	A Dec/31/2008 B 0.12 D
6	A36	=STRJOIN(A21:C22,A24," , ")	A , Dec/31/2008 , B , 0.12 , D
How about this suggest?

Option Explicit

Function STRJOIN(ParamArray VariantR())
Dim i As Double, j As Double
Dim AddStr     As String
Dim MaxB       As Double
Dim AnsS()     As String
Dim ChkStrN    As Double
     MaxB = UBound(VariantR)

If TypeName(VariantR(MaxB)) = "Range" Then
     AddStr = Chr(65000) & "," & Chr(65000)
Else
     AddStr = Chr(65000) & VariantR(MaxB) & Chr(65000)
     MaxB = MaxB - 1
End If

ReDim AnsS(MaxB) As String
     ChkStrN = Len(AddStr)
Dim r As Range
For i = 0 To MaxB
     If TypeName(VariantR(i)) = "Range" Then
     If VariantR(i).Count > 1 Then
          Set r = VariantR(i)
          AnsS(i) = MVV(r, AddStr)
          Else
          AnsS(i) = VariantR(i)
          End If
     Else
          AnsS(i) = VariantR(i)
     End If
Next
     STRJOIN = Join(AnsS, AddStr)
If InStr(STRJOIN, AddStr) = 1 Then
STRJOIN = Mid(STRJOIN, ChkStrN + 1)
ElseIf Right(STRJOIN, ChkStrN) = AddStr Then
STRJOIN = Left(STRJOIN, Len(STRJOIN) - ChkStrN)
End If
     STRJOIN = Replace(STRJOIN, Chr(65000), "")
End Function

Function MVV(tmpV As Range, tmpStr As String)
Dim ii As Double
Dim jj As Double
Dim kk As Double
Dim LB1 As Double, LB2 As Double
Dim AnsY
LB1 = tmpV.Rows.Count
LB2 = tmpV.Columns.Count
ReDim AnsY(1 To 1)
     For ii = 1 To LB1
     For jj = 1 To LB2
          If CStr(tmpV(ii, jj)) <> "" Then
               kk = kk + 1
               ReDim Preserve AnsY(1 To kk)
               AnsY(kk) = tmpV(ii, jj).Text
          End If
     Next
     Next
MVV = Join(AnsY, tmpStr)
End Function
Any Bug Or Ask ... Mail Or Post Reply