amindavod
پنج شنبه 27 اردیبهشت 1386, 16:18 عصر
با سلام وخسته نباشید من تازه اومدم وفقط برای پیدا کردن جوا سوالام که فکر کنم اینجا پیدا بشه من باید تعداد زیادی عدد را به حروف تبدیل کنم می دونم که باید از اکسس وماجولها استفاده اکسس را در حد فرم وکوری وریپورد و...بلدم ولی اصلا نمی دونم ماجول وماکرو چی هست حالا کسی حاضره به من فقیر در این علم کمک کنه
البته میدونم که باید از تابع زیر استفاده کنم ولی چطوری؟ نمی دونم
Option Compare Database
Function Adad(ByVal Number As Double) As String
If Number = 0 Then
Adad = ''صفر''
End If
Dim Flag As Boolean
Dim S As String
Dim I, L As Byte
Dim K(1 To 5) As Double
S = Trim(Str(Number))
L = Len(S)
If L > 15 Then
Adad = ''بسیار بزرگ''
Exit Function
End If
For I = 1 To 15 - L
S = ''0'' & S
Next I
For I = 1 To Int((L / 3) + 0.99)
K(5 - I + 1) = Val(Mid(S, 3 * (5 - I) + 1, 3))
Next I
Flag = False
S = ''''
For I = 1 To 5
If K(I) <> 0 Then
Select Case I
Case 1
S = S & Three(K(I)) & '' تریلیون''
Flag = True
Case 2
S = S & IIf(Flag = True, '' و '', '''') & Three(K(I)) & '' میلیارد''
Flag = True
Case 3
S = S & IIf(Flag = True, '' و '', '''') & Three(K(I)) & '' میلیون''
Flag = True
Case 4
S = S & IIf(Flag = True, '' و '', '''') & Three(K(I)) & '' هزار''
Flag = True
Case 5
S = S & IIf(Flag = True, '' و '', '''') & Three(K(I))
End Select
End If
Next I
Adad = S
End Function
Function Three(ByVal Number As Integer) As String
Dim S As String
Dim I, L As Long
Dim h(1 To 3) As Byte
Dim Flag As Boolean
L = Len(Trim(Str(Number)))
If Number = 0 Then
Three = ''''
Exit Function
End If
If Number = 100 Then
Three = ''یکصد''
Exit Function
End If
If L = 2 Then h(1) = 0
If L = 1 Then
h(1) = 0
h(2) = 0
End If
For I = 1 To L
h(3 - I + 1) = Mid(Trim(Str(Number)), L - I + 1, 1)
Next I
Select Case h(1)
Case 1
S = ''یکصد''
Case 2
S = ''دویست''
Case 3
S = ''سیصد''
Case 4
S = ''چهارصد''
Case 5
S = ''پانصد''
Case 6
S = ''ششصد''
Case 7
S = ''هفتصد''
Case 8
S = ''هشتصد''
Case 9
S = ''نهصد''
End Select
Select Case h(2)
Case 1
Select Case h(3)
Case 0
S = S & '' و '' & ''ده''
Case 1
S = S & '' و '' & ''یازده''
Case 2
S = S & '' و '' & ''دوازده''
Case 3
S = S & '' و '' & ''سیزده''
Case 4
S = S & '' و '' & ''چهارده''
Case 5
S = S & '' و '' & ''پانزده''
Case 6
S = S & '' و '' & ''شانزده''
Case 7
S = S & '' و '' & ''هفده''
Case 8
S = S & '' و '' & ''هجده''
Case 9
S = S & '' و '' & ''نوزده''
End Select
Case 2
S = S & '' و '' & ''بیست''
Case 3
S = S & '' و '' & ''سی''
Case 4
S = S & '' و '' & ''چهل''
Case 5
S = S & '' و '' & ''پنجاه''
Case 6
S = S & '' و '' & ''شصت''
Case 7
S = S & '' و '' & ''هفتاد''
Case 8
S = S & '' و '' & ''هشتاد''
Case 9
S = S & '' و '' & ''نود''
End Select
If h(2) <> 1 Then
Select Case h(3)
Case 1
S = S & '' و '' & ''یک''
Case 2
S = S & '' و '' & ''دو''
Case 3
S = S & '' و '' & ''سه''
Case 4
S = S & '' و '' & ''چهار''
Case 5
S = S & '' و '' & ''پنج''
Case 6
S = S & '' و '' & ''شش''
Case 7
S = S & '' و '' & ''هفت''
Case 8
S = S & '' و '' & ''هشت''
Case 9
S = S & '' و '' & ''نه''
End Select
End If
S = IIf(L < 3, Right(S, Len(S) - 3), S)
Three = S
End Function
اگه کسی هست لطفا این هدیه رو به من بده
البته میدونم که باید از تابع زیر استفاده کنم ولی چطوری؟ نمی دونم
Option Compare Database
Function Adad(ByVal Number As Double) As String
If Number = 0 Then
Adad = ''صفر''
End If
Dim Flag As Boolean
Dim S As String
Dim I, L As Byte
Dim K(1 To 5) As Double
S = Trim(Str(Number))
L = Len(S)
If L > 15 Then
Adad = ''بسیار بزرگ''
Exit Function
End If
For I = 1 To 15 - L
S = ''0'' & S
Next I
For I = 1 To Int((L / 3) + 0.99)
K(5 - I + 1) = Val(Mid(S, 3 * (5 - I) + 1, 3))
Next I
Flag = False
S = ''''
For I = 1 To 5
If K(I) <> 0 Then
Select Case I
Case 1
S = S & Three(K(I)) & '' تریلیون''
Flag = True
Case 2
S = S & IIf(Flag = True, '' و '', '''') & Three(K(I)) & '' میلیارد''
Flag = True
Case 3
S = S & IIf(Flag = True, '' و '', '''') & Three(K(I)) & '' میلیون''
Flag = True
Case 4
S = S & IIf(Flag = True, '' و '', '''') & Three(K(I)) & '' هزار''
Flag = True
Case 5
S = S & IIf(Flag = True, '' و '', '''') & Three(K(I))
End Select
End If
Next I
Adad = S
End Function
Function Three(ByVal Number As Integer) As String
Dim S As String
Dim I, L As Long
Dim h(1 To 3) As Byte
Dim Flag As Boolean
L = Len(Trim(Str(Number)))
If Number = 0 Then
Three = ''''
Exit Function
End If
If Number = 100 Then
Three = ''یکصد''
Exit Function
End If
If L = 2 Then h(1) = 0
If L = 1 Then
h(1) = 0
h(2) = 0
End If
For I = 1 To L
h(3 - I + 1) = Mid(Trim(Str(Number)), L - I + 1, 1)
Next I
Select Case h(1)
Case 1
S = ''یکصد''
Case 2
S = ''دویست''
Case 3
S = ''سیصد''
Case 4
S = ''چهارصد''
Case 5
S = ''پانصد''
Case 6
S = ''ششصد''
Case 7
S = ''هفتصد''
Case 8
S = ''هشتصد''
Case 9
S = ''نهصد''
End Select
Select Case h(2)
Case 1
Select Case h(3)
Case 0
S = S & '' و '' & ''ده''
Case 1
S = S & '' و '' & ''یازده''
Case 2
S = S & '' و '' & ''دوازده''
Case 3
S = S & '' و '' & ''سیزده''
Case 4
S = S & '' و '' & ''چهارده''
Case 5
S = S & '' و '' & ''پانزده''
Case 6
S = S & '' و '' & ''شانزده''
Case 7
S = S & '' و '' & ''هفده''
Case 8
S = S & '' و '' & ''هجده''
Case 9
S = S & '' و '' & ''نوزده''
End Select
Case 2
S = S & '' و '' & ''بیست''
Case 3
S = S & '' و '' & ''سی''
Case 4
S = S & '' و '' & ''چهل''
Case 5
S = S & '' و '' & ''پنجاه''
Case 6
S = S & '' و '' & ''شصت''
Case 7
S = S & '' و '' & ''هفتاد''
Case 8
S = S & '' و '' & ''هشتاد''
Case 9
S = S & '' و '' & ''نود''
End Select
If h(2) <> 1 Then
Select Case h(3)
Case 1
S = S & '' و '' & ''یک''
Case 2
S = S & '' و '' & ''دو''
Case 3
S = S & '' و '' & ''سه''
Case 4
S = S & '' و '' & ''چهار''
Case 5
S = S & '' و '' & ''پنج''
Case 6
S = S & '' و '' & ''شش''
Case 7
S = S & '' و '' & ''هفت''
Case 8
S = S & '' و '' & ''هشت''
Case 9
S = S & '' و '' & ''نه''
End Select
End If
S = IIf(L < 3, Right(S, Len(S) - 3), S)
Three = S
End Function
اگه کسی هست لطفا این هدیه رو به من بده