كود تحويل الارقام الى أحرف في الاكسيس
بسم الله الرحمن الرحيم
تحية طيبة ,,,,,,
السلام وعليكم ورحمته الله وبركاته , واسعد الله اوقاتكم بكل خير "حماكم الله ؛ وحمى صحتكم ؛ وأحباءكم ؛ وحفظ الوطن وقيادته ؛ والانسانية جمعاء من شر هذا الوباء نحن في خدمتكم ونجاحنا بالاشتراك بالقناة ومشاركتها على اصدقاءكم وزيادة عدد المشهادات على القناة والمدونة".
ابدأ بأن تشترك في قناتي على اليوتيوب وتفعيل جرس ليصلك كل جديد : قناتي اليوتيوب
برنامج حضور طلاب تم انشاءها على الاكسيس 2016 بالعربي , وهو برنامج سهل للغاية ومن ميزات البرنامج حضور طلاب تسجيل دوام طلاب يومين عن طريق الباركود.
ان البرنامج الحضور طلاب يتكون من عدد من الايقونات ومنها
1- ادخال طالب جديد.
2- تعديل معلومات طالب.
3- تعديل دوام طلاب (حضور, غياب , مجاز) .
4- ادخال طالب عن طريق ضغطة زر وحدة .
5- ادخال حضور طالب عن طريق الباركود.
6- يوجد تقرير وكشوفات للحضور والغياب لكل طالب.
لتحميل البرنامج حضور طلاب 2021 اضغط هنا
او يمكنك تحميل برنامج لأثبات غياب الطلاب ومتابعة اصدار الإنذارات اليومية والشهرية مجاني.
لتحميل البرنامج اعلاه هنا
ولا تنسى تحميل برنامج مكتبة لتنظيم الكتب المدرسية مجاني| 2020
لتحميل البرنامج اعلاه هنا
Option Compare Database
Option Explicit
Function IsNothing(VarToTest As Variant) As Boolean
IsNothing = True
Dim lngI As Long
Select Case VarType(VarToTest)
Case 0, 1
Exit Function
Case 2 To 6
IsNothing = VarToTest = 0
Case 7
IsNothing = False
Case 8
For lngI = 1 To Len(VarToTest)
If Mid$(VarToTest, lngI, 1) <> " " Then
IsNothing = False
Exit Function
End If
Next lngI
Case 11
IsNothing = Not VarToTest
End Select
End Function
Function KaremHundred(xNumber As Integer) As String
On Error Resume Next
Dim strTemp As String, StrTen As String, StrOne As String
Dim StrHundred As String
Dim One As Integer, Ten As Integer, Hundred As Integer
Const Xten As String = " عشر"
Const won As String = "ون"
Const Xi As Integer = 2
Const wa As String = " و "
Static NumText(999) As String
' If IsNothing(NumText(0)) Then
NumText(0) = ""
NumText(1) = "واحد"
NumText(2) = "اثنان"
NumText(3) = "ثلاثه"
NumText(4) = "اربعة"
NumText(5) = "خمسة"
NumText(6) = "ستة"
NumText(7) = "سبعة"
NumText(8) = "ثمانية"
NumText(9) = "تسعة"
NumText(10) = "عشره"
NumText(11) = "احدى عشر"
NumText(12) = "اثناعشر"
NumText(13) = NumText(3) & Xten
NumText(14) = NumText(4) & Xten
NumText(15) = NumText(5) & Xten
NumText(16) = NumText(6) & Xten
NumText(17) = NumText(7) & Xten
NumText(18) = NumText(8) & Xten
NumText(19) = NumText(9) & Xten
NumText(20) = "عشرون"
NumText(30) = Left$(NumText(3), 4) & won
NumText(40) = Left$(NumText(4), 4) & won
NumText(50) = Left$(NumText(5), 3) & won
NumText(60) = Left$(NumText(6), 2) & won
NumText(70) = Left$(NumText(7), 3) & won
NumText(80) = Left$(NumText(8), 4) & won
NumText(90) = Left$(NumText(9), 3) & won
NumText(100) = "مائة"
NumText(200) = "مائتان"
NumText(300) = "ثلاثمائة"
NumText(400) = "اربعمائة"
NumText(500) = "خمسمائة"
NumText(600) = "ستمائة"
NumText(700) = "سبعمائة"
NumText(800) = "ثمانمائة"
NumText(900) = "تسعمائة"
'End If
If NumText(xNumber) <> "" Then
KaremHundred = NumText(xNumber)
Else
strTemp = Trim$(CStr(xNumber))
Select Case Len(strTemp)
Case 2
StrTen = Left$(strTemp, 1)
StrOne = Mid$(strTemp, 2)
Ten = CInt(StrTen)
One = CInt(StrOne)
KaremHundred = NumText(Ten * 10)
If One > 0 Then
KaremHundred = NumText(One) & wa & KaremHundred
End If
Case 3
StrHundred = Left$(strTemp, 1)
Hundred = CInt(StrHundred) * 100
StrTen = Mid$(strTemp, 2)
Ten = CInt(StrTen)
KaremHundred = NumText(Hundred) & wa & KaremHundred(Ten)
End Select
End If
'Erase NumText
End Function
Function KaremPart(LnPart As Integer, Number As Integer) As String
On Error Resume Next
Const Thousand As String = " الاف "
Const Milion As String = " مليون "
Const Miliar As String = " ميليار "
Select Case LnPart
Case 0 To 3
KaremPart = KaremHundred(Number)
Case 4 To 6
Select Case Number
Case 0
KaremPart = ""
Case 1
KaremPart = " الف "
Case 2
KaremPart = " الفان "
Case 3 To 10
KaremPart = KaremHundred(Number) & Thousand
Case 11 To 999
KaremPart = KaremHundred(Number) & " الف "
End Select
Case 7 To 9
Select Case Number
Case 0
KaremPart = ""
Case 1
KaremPart = " مليون "
Case 2
KaremPart = " مليونان "
Case 3 To 999
KaremPart = KaremHundred(Number) & Milion
End Select
Case Is > 9
Select Case Number
Case 0
KaremPart = ""
Case 1
KaremPart = " مليار "
Case 2
KaremPart = " ملياران "
Case 3 To 999
KaremPart = KaremHundred(Number) & Miliar
End Select
End Select
End Function
Function KaremNumber(vNumber As Variant) As String
On Error Resume Next
If (IsNothing(vNumber) Or Not IsNumeric(vNumber)) Then
KaremNumber = ""
Exit Function
End If
Const wa As String = " و "
Dim LeftPart As String, PercentPart As String '** Extract Percent From Number ***'
Dim nFormat As String
Dim IntPoint As Integer
Dim nMod As Integer
Dim temp As String
Dim nHundred As Integer, nThousand As Integer
nFormat = Format(vNumber, "00.00")
IntPoint = InStr(nFormat, ".")
LeftPart = Left$(nFormat, IntPoint - 1)
PercentPart = Mid$(nFormat, IntPoint + 1)
If Left$(LeftPart, 1) = "-" Then LeftPart = Mid$(LeftPart, 2)
nMod = Len(LeftPart) Mod 3
If nMod > 0 Then
nThousand = CInt(Left$(LeftPart, nMod))
temp = KaremPart(Len(LeftPart), nThousand)
LeftPart = Mid$(LeftPart, nMod + 1)
End If
Do While LeftPart <> ""
nHundred = CInt(Left$(LeftPart, 3))
If Val(nHundred) > 0 Then
temp = IIf(IsNothing(temp), KaremPart(Len(LeftPart), nHundred), _
temp & wa & KaremPart(Len(LeftPart), nHundred))
End If
LeftPart = Mid$(LeftPart, 4)
Loop
If Not IsNothing(temp) Then
temp = temp & " "
End If
KaremNumber = temp & " " & IIf(IsNothing(KaremHundred(CInt(PercentPart))), "", wa & KaremHundred(CInt(PercentPart)) & " بالعشرة ")
End Function
اشترك في بريدنا الالكتروني لتتوصل باشعار فور نشر موضوع جديد
اذا واجهت اي صعوبة في تحميل كود لا تتردد في تواصل معي
ردحذف