مقدمه : در این یادداشت تابع مربوط به تبدیل عدد به معادل حروفی آن ارائه می کنم . عمدتا در سیستم های مالی و حسابداری نیاز است معادل حروفی اعداد هم نمایش داده شده یا چاپ شوند که توابع زیر این نیاز را پاسخ می دهد. مثلا برای چاپ یک چک روی خود برگه چک ، علاوه بر نیاز به چاپ مبلغ عددی چک لازمست تا مبلغ حروفی چک هم روی برگه چاپ شود.
پاسخ : تابع تبدیل عدد به حروف در اکسس نحوه استفاده از تابع : تابع Adad که در زیر ارائه شده است یک عدد را بعنوان ورودی گرفته و معادل حروفی آن عدد در زبان فارسی را بعنوان خروجی تولید می کند. مثلا (Adad(1373 مقدار”یکهزار و سیصد و هفتاد و سه” را بعنوان خروجی تولید می کند.برای استفاده از این توابع باید از چند خط پایین تر (Start of Module) تا انتهای این یادداشت را در حافظه کپی (Copy) کرده و در یک ماجول جدید در اکسس یا VB ، Paste کنید . ( توجه داشته باشید که نمایش کدهای نوشته شده در اینجا راست به چپ است که پس از کپی کردن آن در ماجول اکسس بشکل صحیح نمایش داده خواهد شد) 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