اذهب الي المحتوي
أوفيسنا

زياد الحسناوي

03 عضو مميز
  • Posts

    477
  • تاريخ الانضمام

  • تاريخ اخر زياره

السمعه بالموقع

67 Excellent

2 متابعين

عن العضو زياد الحسناوي

البيانات الشخصية

  • Gender (Ar)
    ذكر
  • Job Title
    PoliceMan
  • البلد
    Iraq
  • الإهتمامات
    Access , VBA , Design , Reading , Sport(GYM), Gun

وسائل التواصل

  • Website URL
    https://www.facebook.com/zeyad.bassim
  • Yahoo
    zozo_zead@yahoo.com

اخر الزوار

2,782 زياره للملف الشخصي
  1. تم حل الموضوع والحمدلله و موضوع الارشفة عندي جدا معقدة وليست كما يتصوره البعض وذلك للتشعب الحاصل بانواع المراسلات اما بخصوص البرنامج للسكنر فتم حل المشكلة وجميع الكتب بصيفة الpdf ومن السكنر مباشرة والحمدلله جاري اضافة اللمسات الاخيرة للبرنامج
  2. تم التعديل و الأمور تمام لم انتبه على الموديول ممنون ولكن هل يمكن نقل اسم الملف والمسار في مسار الملف للفورمين وجعل اسم الملف (رقم الكتاب + التاريخ) NewScan.accdb
  3. السلام عليكم عندي مشكلة بالنموذج FScanSader يتم فتح اولا النموذج QSaderK ومن ثم زر المرفقات لفتح الفورم اعلاه ولكن تظهر المشكلة الاتية NewScan.accdb
  4. السلام عليكم تم نقل الاكواد ولكن توجد مشكلة بـ انشاء المجلد اولا ثانيا بتسجيل اسم الملف (رقم الكتاب + التاريخ) مثلا 124 6-11-2023 حيث 124 هو رقم الكتاب و 6-11-2023 التاريخ ثالثا بالسحب من السكنر NewScan.accdb
  5. Up جربت انقل الاكواد واعدل عليها بس للاسف بدون فائدة
  6. السلام عليكم الملف الاول OldScan.accdb يوجد فيه اكواد خاصة بالسكنر و سحب الملفات من الهارد مع تغير الاسم و حفظها في مجلد معين المطلوب تطبيق الاكواد على القاعدة الجديد NewScan.accdb بحيث عند سحب السكنر او ادراج ملفات يتم حفظها بناءا على رقم الكتاب و التاريخ
  7. Function NoToTxt(TheNo As Double, MyCur As String, MySubCur As String) As String Dim MyArry1(0 To 9) As String Dim MyArry2(0 To 9) As String Dim MyArry3(0 To 9) As String Dim MyNo As String Dim GetNo As String Dim RdNo As String Dim My100 As String Dim My10 As String Dim My1 As String Dim My11 As String Dim My12 As String Dim GetTxt As String Dim Mybillion As String Dim MyMillion As String Dim MyThou As String Dim MyHun As String Dim MyFraction As String Dim MyAnd As String Dim i As Integer Dim remark As String If TheNo > 999999999999.99 Then Exit Function If TheNo = 0 Then NoToTxt = "صفر" Exit Function End If MyAnd = " و" MyArry1(0) = "" MyArry1(1) = "مائة" MyArry1(2) = "مائتان" MyArry1(3) = "ثلاثمائة" MyArry1(4) = "أربعمائة" MyArry1(5) = "خمسمائة" MyArry1(6) = "ستمائة" MyArry1(7) = "سبعمائة" MyArry1(8) = "ثمانمائة" MyArry1(9) = "تسعمائة" MyArry2(0) = "" MyArry2(1) = " عشر" MyArry2(2) = "عشرون" MyArry2(3) = "ثلاثون" MyArry2(4) = "أربعون" MyArry2(5) = "خمسون" MyArry2(6) = "ستون" MyArry2(7) = "سبعون" MyArry2(8) = "ثمانون" MyArry2(9) = "تسعون" MyArry3(0) = "" MyArry3(1) = "واحد" MyArry3(2) = "اثنان" MyArry3(3) = "ثلاثة" MyArry3(4) = "أربعة" MyArry3(5) = "خمسة" MyArry3(6) = "ستة" MyArry3(7) = "سبعة" MyArry3(8) = "ثمانية" MyArry3(9) = "تسعة" '====================== GetNo = Format(TheNo, "000000000000.00") i = 0 Do While i < 15 If i < 12 Then MyNo = Mid$(GetNo, i + 1, 3) Else MyNo = "0" + Mid$(GetNo, i + 2, 2) End If If (Mid$(MyNo, 1, 3)) > 0 Then RdNo = Mid$(MyNo, 1, 1) My100 = MyArry1(RdNo) RdNo = Mid$(MyNo, 3, 1) My1 = MyArry3(RdNo) RdNo = Mid$(MyNo, 2, 1) My10 = MyArry2(RdNo) If Mid$(MyNo, 2, 2) = 11 Then My11 = "إحدى عشر" If Mid$(MyNo, 2, 2) = 12 Then My12 = "إثنى عشر" If Mid$(MyNo, 2, 2) = 10 Then My10 = "عشرة" If ((Mid$(MyNo, 1, 1)) > 0) And ((Mid$(MyNo, 2, 2)) > 0) Then My100 = My100 + MyAnd If ((Mid$(MyNo, 3, 1)) > 0) And ((Mid$(MyNo, 2, 1)) > 1) Then My1 = My1 + MyAnd GetTxt = My100 + My1 + My10 If ((Mid$(MyNo, 3, 1)) = 1) And ((Mid$(MyNo, 2, 1)) = 1) Then GetTxt = My100 + My11 If ((Mid$(MyNo, 1, 1)) = 0) Then GetTxt = My11 End If If ((Mid$(MyNo, 3, 1)) = 2) And ((Mid$(MyNo, 2, 1)) = 1) Then GetTxt = My100 + My12 If ((Mid$(MyNo, 1, 1)) = 0) Then GetTxt = My12 End If If (i = 0) And (GetTxt <> "") Then If ((Mid$(MyNo, 1, 3)) > 10) Then Mybillion = GetTxt + " مليار" Else Mybillion = GetTxt + " مليارات" If ((Mid$(MyNo, 1, 3)) = 2) Then Mybillion = " مليار" If ((Mid$(MyNo, 1, 3)) = 2) Then Mybillion = " ملياران" End If End If If (i = 3) And (GetTxt <> "") Then If ((Mid$(MyNo, 1, 3)) > 10) Then MyMillion = GetTxt + " مليون" Else MyMillion = GetTxt + " ملايين" If ((Mid$(MyNo, 1, 3)) = 1) Then MyMillion = " مليون" If ((Mid$(MyNo, 1, 3)) = 2) Then MyMillion = " مليونان" End If End If If (i = 6) And (GetTxt <> "") Then If ((Mid$(MyNo, 1, 3)) > 10) Then MyThou = GetTxt + " ألف" Else MyThou = GetTxt + " آلاف" If ((Mid$(MyNo, 3, 1)) = 1) Then MyThou = " ألف" If ((Mid$(MyNo, 3, 1)) = 2) Then MyThou = " ألفان" End If End If If (i = 9) And (GetTxt <> "") Then MyHun = GetTxt If (i = 12) And (GetTxt <> "") Then MyFraction = GetTxt End If i = i + 3 Loop If (Mybillion <> "") Then If (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then Mybillion = Mybillion + MyAnd End If If (MyMillion <> "") Then If (MyThou <> "") Or (MyHun <> "") Then MyMillion = MyMillion + MyAnd End If If (MyThou <> "") Then If (MyHun <> "") Then MyThou = MyThou + MyAnd End If If MyFraction <> "" Then If (Mybillion <> "") Or (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then NoToTxt = remark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur + MyAnd + MyFraction + " " + MySubCur Else NoToTxt = remark + MyFraction + " " + MySubCur End If Else NoToTxt = remark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur End If End Function استخدم هذا الكود تفقيط الارقام فى الاكسس.accdb وهذا الكود يحول من الأرقام إلى الحروف و لكن باللغة الأنجليزية و هو بالطبع بلغة الفيجوال بيسك للتطبيقات المرفقة مع قواعد بيانات أكسس و يمكنك وضع الكود في MODULE و تسميه NumberToWrod و تقوم بعمل اللازم بعد ذلك و الكود هو [B][SIZE=6][B][SIZE=3]Function ConvertCurrencyToEnglish(ByVal mynumber) Dim Temp Dim Dollars, Cents Dim DecimalPlace, Count ReDim Place(9) As String Place(2) = " Thousand " Place(3) = " Million " Place(4) = " Billion " Place(5) = " Trillion " ' Convert MyNumber to a string, trimming extra spaces. If Not mynumber = Null Then mynumber = Trim(Str(mynumber)) End If ' Find decimal place. DecimalPlace = InStr(mynumber, ".") ' If we find decimal place... If DecimalPlace > 0 Then ' Convert cents Temp = Left(Mid(mynumber, DecimalPlace + 1) & "00", 2) Cents = ConvertTens(Temp) ' Strip off cents from remainder to convert. mynumber = Trim(Left(mynumber, DecimalPlace - 1)) End If Count = 1 Do While mynumber <> "" ' Convert last 3 digits of MyNumber to English dollars. Temp = ConvertHundreds(Right(mynumber, 3)) If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars If Len(mynumber) > 3 Then ' Remove last 3 converted digits from MyNumber. mynumber = Left(mynumber, Len(mynumber) - 3) Else mynumber = "" End If Count = Count + 1 Loop ' Clean up dollars. Select Case Dollars Case "" Dollars = "Zero Dirham" Case "One" Dollars = "One Dirham" Case Else Dollars = Dollars & " Dirhams" End Select ' Clean up cents. Select Case Cents Case "" Cents = " And Zero Fils Only." Case "One" Cents = " And One Fils Only." Case Else Cents = " And " & Cents & " Fils Only." End Select ConvertCurrencyToEnglish = Dollars & Cents End Function Private Function ConvertHundreds(ByVal mynumber) Dim Result As String ' Exit if there is nothing to convert. If Val(mynumber) = 0 Then Exit Function ' Append leading zeros to number. mynumber = Right("000" & mynumber, 3) ' Do we have a hundreds place digit to convert? If Left(mynumber, 1) <> "0" Then Result = ConvertDigit(Left(mynumber, 1)) & " Hundred " End If ' Do we have a tens place digit to convert? If Mid(mynumber, 2, 1) <> "0" Then Result = Result & ConvertTens(Mid(mynumber, 2)) Else ' If not, then convert the ones place digit. Result = Result & ConvertDigit(Mid(mynumber, 3)) End If ConvertHundreds = Trim(Result) End Function Private Function ConvertTens(ByVal MyTens) Dim Result As String ' Is value between 10 and 19? If Val(Left(MyTens, 1)) = 1 Then Select Case Val(MyTens) Case 10: Result = "Ten" Case 11: Result = "Eleven" Case 12: Result = "Twelve" Case 13: Result = "Thirteen" Case 14: Result = "Fourteen" Case 15: Result = "Fifteen" Case 16: Result = "Sixteen" Case 17: Result = "Seventeen" Case 18: Result = "Eighteen" Case 19: Result = "Nineteen" Case Else End Select Else ' .. otherwise it's between 20 and 99. Select Case Val(Left(MyTens, 1)) Case 2: Result = "Twenty " Case 3: Result = "Thirty " Case 4: Result = "Forty " Case 5: Result = "Fifty " Case 6: Result = "Sixty " Case 7: Result = "Seventy " Case 8: Result = "Eighty " Case 9: Result = "Ninety " Case Else End Select ' Convert ones place digit. Result = Result & ConvertDigit(Right(MyTens, 1)) End If ConvertTens = Result End Function Private Function ConvertDigit(ByVal MyDigit) Select Case Val(MyDigit) Case 1: ConvertDigit = "One" Case 2: ConvertDigit = "Two" Case 3: ConvertDigit = "Three" Case 4: ConvertDigit = "Four" Case 5: ConvertDigit = "Five" Case 6: ConvertDigit = "Six" Case 7: ConvertDigit = "Seven" Case 8: ConvertDigit = "Eight" Case 9: ConvertDigit = "Nine" Case Else: ConvertDigit = "" End Select[/SIZE] [SIZE=3]End Function[/SIZE][/B][/SIZE][/B]
  8. للاسف ماكو طريقة تضع كلمة مرور لطريقة عرض التصميم ولكن لديك الاتي اولا حفظ الملف بامتداد ACCDE ثانيا موديل اخفاء عناصر الاكسس و الغاء الشفت
  9. وعليكم السلام وين الفراغ ماشايف فراغ بالتقرير ؟
  10. نعم اعمل عليه الآن وسيتم الانتهاء منه قريبا أكيد و سوف نجد حلا لهذه المشكلة ان شاء الله
×
×
  • اضف...

Important Information