egyman

أشكرك أخي التقني و جزاك الله خيراً

البرنامج رائع ... و لكن لا يوجد به ملف صوت للجرس .... شباب ملف صوت جرس مدرسي لله.....

رمضان كريم ارسل و سنكون لك من الشاكرين إن شاء الله

بسم الله الرحمن الرحيم شباب أعرف أن هذا ليس المكان المناسب لطرح سؤالي .. و لكني لا أعرف مكان أخر قمت بعمل برنامج صغير لمدرسة يقوم البرنامج بتشغيل صوت جرس على مواعيد الحصص و البرنامج تمام و الحمد لله و اللى ناقص ملف صوت الجرس فهل أجد عنكم ضالتى و شكراً :d

بسم الله الرحمن الرحيم أتفق مع أخي rudwan تحليل ممتاز لماذا لا نكون فريق عمل و نبدأ على بركة الله

أولاً : بود أشكر الأستاذ أبو هادي على الملف المرفق و على حرصه على نشر العلم بين أفراد المنتدي و بالطبع الشكر كل الشكر للأستاذ أبو هاجر و لكن يا شباب أنا عندي مشكلة ::: منذ ما يقرب من شهر و نصف قمت بتحميل ملف من متندى أجنبيى يؤدى نفس الوظيفة و الملف شغال و ذي الفل المشكلة بقي ... فى الطباعة العميل عنده طابعة Printer card حجم الورقة in CR 80 2.13 × 3.38 فقمت بتصغير ورقة التقرير لتتناسب مع مساحة ورقة الطابعة و لكنها أيضاُ لا تطبع بشكل جيد فهل عند أحدكم خبرة فى طباعة الكروت البلاستيك على أحد الطابعات مثل طابعتى و شكراً لكم أنتظر ردودكم بفارغ الصبر

السلام عليكم و رحمة الله و بركاته أخي أسير الغربة أود أولاً أن أنصحك بأن تسمي أدواتك بحروف أو أسماء إنجليزية حتى لا تقع فى مشكلة أثناء كتابة الكود و سأفترض معك أن أداة القائمة المنسدلة تسمي Gender --> الجنس قم بإضافة الكود التالي على زر الحفظ If me.gender = "ذكر" then me.t = 1 me.h = 0 else me.t = 0 me.h = 1 endif أرجوا أن يكون ذلك ما تريد

Me.FilterOn = False Me.CODE.Enabled = True المشكلة كانت فى السطر التالي .. حيث كان حقل الكود غير ممكن Me.CODE.SetFocus DoCmd.FindRecord dd, , , True, , acCurrent Me.DATE.SetFocus Me.CODE.Enabled = False Me.Recordset.MovePrevious If Me.Recordset.BOF() Then Me.Recordset.MoveFirst End If

شباب السهل يمكن سهل بس صدقونى مش سهل .... عندي فورم للدخلو عليه بقوم بعمل Filter على السجل المطلوب داخل الجدول المرتبط بالنموذج تمام لغاية هنا المشكلة ان عندي أزرار للتنقل بين السجلات للذهاب لأول سجل أو لأخر سجل لا يوجد مشكلة المشكلة فى الذهاب للسجل التالي أو السابق شباب الموضوع مهم أرجوا ردودكم السريعة و شكراً

السلام عليكم و رحمة الله و بركاته أخي العزيز إذا كنت قد استوعبت سؤالك جيداّ فأنت تبحث عن استخدام النموذج الفرعي sub report

بسم الله الرحمن الرحيم لجعل التقرير ظهر كما فهمت بالشكل التالي نسخة (1) من (2) أي بإضافة الأقواس عن الشكل العادي نسخة 1 من 2 استخدم السطر التالي: ="نسخة (" & & ") من (" & [Pages] & ")" أرجوا ان يكون ذلك ما قصدت

السلام عليكم ورحمة الله و بركاته شكرأ أخي رضوان لتفاعلك معي و لكن يا صديقي المشكلة ليسة في تكبير الشاشة لاستخدم الأمر الذي ذكرته أو حتى أن استخدم ماكروا لذلك أرجوا أن تجرب ذلك عملياً و ستعرف ما أقصد و شكراً لك :d

السلام عليكم و رحمة الله و بركاته سؤالي هو قمت بتصميم بعض النماذج و كانت شاشتى 15 بوصة و عند نقلها إلى العميل ذو الشاشة 17 بوصة بالطبع لم تظهر بالشكل الجيد فهل عند أحدكم حل لعدم تكرار ذلك عند التصميم و شكراً

السلام عليكم و رحمة الله و بركاته ... يا شباب أنا أعمل الأن على نظام للمخازن و حسابات المخزون و أردت أن أعرض الحسابات على شكل شجرة و على ما أعتقد أن ما أحتاج إليه هو ملف ocx فمن يملك هذا الملف أو طريقة للحل أرجوا ألا يبخل بها علينا جميعاً و شكراً

بالتأكيد أخي عصام

السلام عليكم ورحمة الله و بركاته ........................................... أعزائي و أخوتي الكرام .. تم طرح موضوع التخلص من رسالة الخطأ التى تنشأ من حدث not in list الخاص بصندوق التحرير و السرد قبل ذلك و قد كان هناك ردود رائعة و لكن عندما قمت بتنفيذها لم تفلح فقمت بإعادة طرح الموضوع مرة أخري و أيضأ أخذت ردود لم تفلح ........................................................ والأن ...... ها هو الحل بعد طول بحث ........ :lol: ........................................................ قم بكتابة الكود التالي فى حدثnotinlist Private Sub cboStateJump_NotInList(NewData As String, Response As Integer) MsgBox "No matching State found..." & "Tamer" & "Please select a State from the list.", vbExclamation, "No Matching State Found" Response = acDataErrContinue End Sub أرجوا منكم تجربته و الدعاء لي بأن يهديني لله... و شكرأ لكم و للسادة المشرفين الذين لا يبخلوا بالمساعدة

السلام عليكم ...................... شكرأ أخي سهيل على الرد فالرابط يؤدي بالفعل إلى الموضوع المطلوب و به ملفات يمكن تحميلها كأمثلة على الجهاز و لكن.............. :') عندما تحاول تشغيلها يعطي رسالة هذا الملف يتنسيق خاطي فإذا كنت تعرف الطريقة أفدنا بها و شكراً

السلام عليكم يا شباب و الله الموضوع مهم .. و محتاج للبحث الجاد .. فكروا معي ما هو حال برامجنا الذي نوزعها على العملاء لتجد أن أحداً قد نسخها و غير اسمك من عليها حتي فى حالات اغلاق مفتاح الشفت ........................... الفكرة .... و قد رأيتها من قبل... .............................. هو كود يكتب داخل ملف تنفيذي يقوم بتحويل ملف الأكسيس إلى نسخة صالحة للإستخدام و عند إغلاق البرنامج يقوم الكود بتحويل النسخة إلى نسخة غير صالحة و شكراً

السلام عليكم يا شباب الموضوع بسيط ... الفكرة هي انت مثلاً قمت بعمل برنامج يتكون من 10 شاشات (نماذج) و قد اخترت اللون الأزرق ليكون هو لون الخلفية لهذه النماذج ........................ الفكرة المطروحة هي : هل نستطيع أن نعرض شاشة بها ألوان للمستخدم ليختار هو بنفسه اللون المريح له ثم بعد ذلك يتغير ألوان خلفة الشاشات بالبرنامج إلى اللون الذي اختاره المستخدم ....................... و شكراً

السلام عليكم و رحمة الله و بركاته .. يا شباب أنا عندي فكرة بس معرفش فعلاَ هي اتعملت قبل كده و لا لا و معرفش فعلاَ مدي تحقيقها و هى هلى يمكن أن أمكن المستخدم من تغيير لون خلفية النموذج و شكراَ

السلام عليكم و رحمة الله و بركاته كل عام و أنتم و الأمة الإسلامية بخير إن شاء الله شباب لا أطيل عليكم أعرف أن المنتدي هو منتدي أكسيس و لكني أسئل عن كود كنت قد رأيته من قبل يقوم هذا الكود بالتالي: عند تنفيذ الكود يقوم بتشفير قاعدة البيانات بمعنى أنك لوحاولت فتح الملف ستظهر رسالة تفيد بعدم فهم صيغة الملف Unrecognze format و عند تشغيل الكود مرة ثانية يقوم بعملية إعادة تشفير الملف و تحويله إلى ملف أكسيس شباب أرجوا منكم المساعدة و شكراً لكم

أعرف أن أسئليتى كثيرة و لكنه العشم يا شباب شباب عن طريق حدث onkeydown منع المستخدم من استخدام زر pageup , pagedown للتنقل بين السجلات و لكن المستخدم يستطيع أن يستخدم كرة الماوس (بكرة الماوس) فكيف نستطيع أن نمنع ذلك

شكراً أخي سهيل على الرد و لكني كتبت كود للتفقيط و لكن المشكلة به : أنه يكتب ثلاث مئة : أربع مئة و كان المطلوب أن يكتب ثلاثمئة : أربعتمئة المهم إني حصلت من أحد المنتديات على كود أفضل من الذي كتبته و هو : v ضع هذا الكود فى حدث عند فقد التركيز لخانة المبلغ : Private Sub s_LostFocus() Me.تفقيط = B_Only(, 1, 0, 2, "ريال سعودي", "ريالات", 0, "هللة", "هللات", 4) End Sub v قم بإنشاء موديل جديد و انسخ به الكود التالي : Option Compare Database Option Explicit Public Const vArabic As Byte = 1 Public Const vEnglish As Byte = 2 Public Const vMale As Byte = 0 Public Const vFemale As Byte = 1 Function Delete(s As String, Index, Count As Integer) As String Delete = Left(s, Index - 1) + _ Mid(s, Index + Count, Len(s)) End Function Function Insert(Source, s As String, Index As Integer) As String Dim LPart, RPart As String LPart = Left(s, Index - 1) RPart = Mid(s, Index, Len(s)) Insert = LPart & Source & RPart End Function Function AddAnd(S1, S2, S3, And_ As String, Lang As Byte) As String Dim InAnd_, CollectS As String If Lang = vArabic Then InAnd_ = " " + And_ Else InAnd_ = And_ + " " If (S1 <> "") And (S2 <> "") Then And_ = InAnd_ Else And_ = "" CollectS = S1 + And_ + S2 If (CollectS <> "") And (S3 <> "") Then And_ = InAnd_ Else And_ = "" AddAnd = CollectS + And_ + S3 End Function Function S2Double(Single_ As Variant, Sex As Byte) As String Dim LLeter As Integer Dim k As Byte Dim Sngl_1, Sngl_2 As String k = InStr(1, Single_ & " ", " ") Sngl_1 = Left(Single_, k - 1) Sngl_2 = "" If k < Len(Single_) Then Sngl_2 = Mid(Single_, k + 1, Len(Single_)) End If If Sngl_2 <> "" Then If Right(Sngl_2, 1) = "ة" Then Sngl_2 = Left(Sngl_2, Len(Sngl_2) - 1) & "تان" Else Sngl_2 = Sngl_2 & "ان" End If End If If Sngl_1 <> "" Then LLeter = Asc(Right(Sngl_1, 1)) Select Case LLeter Case 201 ' "ة" Sngl_1 = Left(Sngl_1, Len(Sngl_1) - 1) & "تان" Case 236 ' "ى" Sngl_1 = Left(Sngl_1, Len(Sngl_1) - 1) & "يان" Case 199 ' "ا" Sngl_1 = Left(Sngl_1, Len(Sngl_1) - 1) & "وان" Case 193 ' "ء" If Right(Sngl_1, 2) = "اء" Then If Sex = 1 Then Sngl_1 = Left(Sngl_1, Len(Sngl_1) - 1) & "وان" Else Sngl_1 = Sngl_1 & "ان" End If End If Case Else If Sngl_1 <> "" Then Sngl_1 = Sngl_1 & "ان" End Select If Sngl_2 <> "" Then S2Double = Sngl_1 & " " & Sngl_2 Else S2Double = Sngl_1 End If End Function Function Fmale(Num, Sex As Byte, Female()) As String Dim Two(1 To 4) As String Dim InSex As Byte Two(1) = "أحد" Two(2) = "اثنان" Two(3) = "إحدى" Two(4) = "ة" Select Case Sex Case vMale: Select Case Num Case 1: Fmale = Mid(Female(1), 1, 4) Case 2: Fmale = Two(2) Case 8: Fmale = Female(Num) + "ي" + Two(4) Case 3 To 7, 9, 10: Fmale = Female(Num) + Two(4) Case 11: Fmale = Two(1) + " " + Female(10) Case 12: Fmale = Mid(Two(2), 1, 4) + " " + Female(10) Case 13 To 19: Fmale = Female(Num - 10) + Two(4) + " " + Female(10) End Select Case vFemale: Select Case Num Case 1 To 10: Fmale = Female(Num) Case 11: Fmale = Two(3) + " " + Female(10) + Two(4) Case 12: Fmale = Mid(Female(2), 1, 5) + " " + Female(10) + Two(4) Case 13 To 19: Fmale = Female(Num - 10) + " " + Female(10) + Two(4) End Select End Select End Function Function Tens(Num As Byte, Female()) As String Const Noon = "ون" Select Case Num Case 2: Tens = Female(10) + Noon Case 3 To 9: Tens = Female(Num) + Noon End Select End Function Function Hunds(Num As Byte, Female()) As String Const Hund = "مائة" Select Case Num Case 1: Hunds = Hund Case 2: Hunds = Mid(Hund, 1, 3) + Mid(Female(2), 4, 3) Case 3 To 9: Hunds = Female(Num) + Hund End Select End Function Function Tenteen(Num As Byte, ETens()) As String Const een = "een" Num = Num Mod 10 Select Case Num Case 3 To 9: Tenteen = Mid(ETens(Num), 1, Len(ETens(Num)) - 1) + een End Select End Function Function EHunds(Num As Byte, ESingle()) As String EHunds = ESingle(Num) + " hundred" End Function Function ReFormat(InNum As Double, Dec As Byte) As Double Dim NewFormat As String If Dec > 0 Then NewFormat = "0." Else NewFormat = "0" NewFormat = NewFormat & String(Dec, "0") ReFormat = Format(InNum, NewFormat) End Function Function ReStr(InNum As String) As String Dim k, Digits As Byte Dim Num_ As String Num_ = LTrim(InNum) k = InStr(1, Num_, "E+", 1) If k > 0 Then Digits = Val(Mid(Num_, k + 2, 3)) Num_ = Left(Num_, k - 1) Num_ = Delete(Num_, 2, 1) Do While Len(Num_) - 1 < Digits Num_ = Insert(Num_, "0", 1) Loop End If ReStr = Num_ End Function Function AOnly(Num_, FracS, Single_, Ploral_ As String, Parts, Sex, Dec As Byte) As String Const And_ As String * 1 = "و" Const Lang = vArabic Dim PartNum(0 To 5) As Long Dim Result1(0 To 5) As String Dim N1, N2, N3, TempI, Sex2, k As Byte Dim Only_ As String Dim OnlyPart As String Dim N1_, N2_ As String Dim N3_ As String Dim Part_ As String Dim TempS As String Dim Sngl_1, Sngl_2 As String Dim Female(1 To 10) As Variant Dim Parts_(0 To 11) As String If Val(Num_) = 0 Then If FracS = "" Then AOnly = RTrim("مسدد نقدي ") Exit Function Else AOnly = FracS & " " & Single_ End If Exit Function End If Female(1) = "واحدة" Female(2) = "اثنتان" Female(3) = "ثلاث" Female(4) = "أربع" Female(5) = "خمس" Female(6) = "ست" Female(7) = "سبع" Female(8) = "ثمان" Female(9) = "تسع" Female(10) = "عشر" Parts_(0) = "" Parts_(1) = "ألف" Parts_(2) = "مليون" Parts_(3) = "مليار" Parts_(4) = "ترليون" Parts_(5) = "كدرليون" Parts_(6) = "" Parts_(7) = "آلاف" Parts_(8) = "ملايين" Parts_(9) = "مليارات" Parts_(10) = "ترليونات" Parts_(11) = "كدرليونات" k = InStr(1, Single_ & " ", " ") Sngl_1 = Left(Single_, k - 1) Sngl_2 = "" If k < Len(Single_) Then Sngl_2 = Mid(Single_, k + 1, Len(Single_)) End If For k = 0 To Parts - 1 PartNum(k) = Val(Mid(Num_, (k * 3) + 1, 3)) Next k Sex2 = Sex For k = 0 To (Parts - 1) If k = (Parts - 1) Then Sex = Sex2 Else Sex = vMale TempS = Mid(Num_, (k * 3) + 1, 3) TempI = Val(Mid(TempS, 2, 2)) N1 = Val(Mid(TempS, 1, 1)) N2 = Val(Mid(TempS, 2, 1)) N3 = Val(Mid(TempS, 3, 1)) '{------------------------------------------} N1_ = "": N2_ = "": N3_ = "" If N1 > 0 Then N1_ = Hunds(CByte(N1), Female()) If PartNum(k) = 200 Then N1_ = Mid(N1_, 1, Len(N1_) - 1) Select Case TempI Case 1 To 2: If k = Parts - 1 Then If FracS <> "" Then N3_ = Fmale(N3, CByte(Sex), Female()) 'Sex Case 3 To 19: N3_ = Fmale(TempI, CByte(Sex), Female()) Case 20 To 99: N2_ = Tens(CByte(N2), Female()) If N3 > 0 Then N3_ = Fmale(N3, CByte(Sex), Female()) If (N3 Mod 10 = 1) And (Sex = vFemale) Then N3_ = "إحدى" End Select OnlyPart = AddAnd(N1_, N3_, N2_, And_, Lang) '{------------------------------------------} If PartNum(k) > 100 Then Select Case TempI Case 1, 2: OnlyPart = AddAnd(OnlyPart, Parts_(Parts - k - 1), "", "", Lang) End Select End If '{------------------------------------------} Part_ = "" If PartNum(k) > 0 Then Part_ = Parts_(Parts - k - 1) If Part_ <> "" Then Select Case TempI Case 2: Part_ = Part_ + "ان" Case 3 To 10: Part_ = Parts_((Parts - k - 1) + 6) Case 11 To 99: Part_ = Part_ + "ا" End Select End If End If '{------------------------------------------} If Part_ <> "" Then If TempI >= 1 And TempI <= 2 Then OnlyPart = AddAnd(OnlyPart, Part_, "", And_, Lang) Else OnlyPart = AddAnd(OnlyPart, Part_, "", "", Lang) End If End If Result1(k) = (OnlyPart) Next k '{------------------------------------------} N1_ = AddAnd(Result1(0), Result1(1), Result1(2), And_, Lang) N2_ = AddAnd(Result1(3), Result1(4), Result1(5), And_, Lang) Only_ = AddAnd(N1_, N2_, "", And_, Lang) If FracS <> "" Then If Only_ <> "" Then FracS = " " + FracS Only_ = AddAnd(Only_, FracS, "", And_, Lang) End If If Only_ <> "" Then If Mid(Only_, Len(Only_), 1) = "ا" Then If Mid(Only_, Len(Only_) - 1, 2) <> "تا" Then Only_ = Mid(Only_, 1, Len(Only_) - 1) End If End If If TempS = "000" Then If Mid(Only_, Len(Only_) - 1, 2) = "ان" Then Only_ = Mid(Only_, 1, Len(Only_) - 1) End If End If End If '{------------------------------------------} If FracS = "" Then Select Case TempI Case 0: If Only_ <> "" Then Only_ = AddAnd(Only_, Single_, "", "", Lang) Case 1: Only_ = AddAnd(Only_, AddAnd(Single_, Fmale(1, CByte(Sex), Female()), "", "", Lang), "", And_, Lang) Case 2: Only_ = AddAnd(Only_, AddAnd(S2Double(Single_, CByte(Sex)), Fmale(2, CByte(Sex), Female()), "", "", Lang), "", And_, Lang) Case 3 To 10: If Sngl_2 <> "" Then If Right(Sngl_2, 1) = "ة" Then Only_ = AddAnd(Only_, Ploral_, Sngl_2, "", Lang) Else Only_ = AddAnd(Only_, Ploral_, Sngl_2 & "ة", "", Lang) End If Else Only_ = AddAnd(Only_, Ploral_, "", "", Lang) End If Case 11 To 99: If Sngl_1 <> "" Then Only_ = AddAnd(Only_, Sngl_1, "", "", Lang) N1_ = Mid(Only_, Len(Only_), 1) Select Case N1_ Case "ة", "ى", "ا" Case Else Only_ = Only_ + "ا" End Select N1_ = Mid(Only_, Len(Only_) - 2, 3) 'هذا الشرط لحل مشكلة عدم التمييز بين "ء" و "ل" 2004/06/03 If N1_ = "اءا" And Asc(Right(Sngl_1, 1)) = 193 Then Only_ = Left(Only_, Len(Only_) - 1) End If If Sngl_2 <> "" Then If Right(Only_, 1) = "ا" Then Only_ = AddAnd(Only_, Sngl_2 & "ا", "", "", Lang) Else Only_ = AddAnd(Only_, Sngl_2, "", "", Lang) End If Else Only_ = AddAnd(Only_, Sngl_2, "", "", Lang) End If End If End Select Else Only_ = AddAnd(Only_, Sngl_1, Sngl_2, "", Lang) End If AOnly = (Only_) End Function Function EOnly(Num_, FracS, Single_ As String, Parts, Dec As Byte) As String Const Lang = vEnglish Dim ESingle(1 To 12) As Variant Dim ETens(2 To 9) As Variant Dim EParts_(0 To 5) As String Dim TempS As String Dim N1, N2, N3, TempI, Sex2 As Byte Dim N1_, N2_, N3_ As String Dim OnlyPart, Part_, Only_ As String Dim Leng, k As Integer Dim PartNum(0 To 5) As Long Dim Result1(0 To 5) As String If Val(Num_) = 0 Then If FracS = "" Then EOnly = LTrim(Single_ & " zero") Else EOnly = Single_ & " " & FracS End If Exit Function End If ESingle(1) = "one" ESingle(2) = "two" ESingle(3) = "three" ESingle(4) = "four" ESingle(5) = "five" ESingle(6) = "six" ESingle(7) = "seven" ESingle(8) = "eight" ESingle(9) = "nine" ESingle(10) = "ten" ESingle(11) = "eleven" ESingle(12) = "twelve" ETens(2) = "twenty" ETens(3) = "thirty" ETens(4) = "forty" ETens(5) = "fifty" ETens(6) = "sixty" ETens(7) = "seventy" ETens(8) = "eighty" ETens(9) = "ninety" EParts_(0) = "" EParts_(1) = "thousund" EParts_(2) = "million" EParts_(3) = "billion" EParts_(4) = "trillion" EParts_(5) = "quadrillion" For k = 0 To Parts - 1 PartNum(k) = Val(Mid(Num_, (k * 3) + 1, 3)) Next k For k = 0 To (Parts - 1) TempS = Mid(Num_, (k * 3) + 1, 3) TempI = Val(Mid(TempS, 2, 2)) N1 = Val(Mid(TempS, 1, 1)) N2 = Val(Mid(TempS, 2, 1)) N3 = Val(Mid(TempS, 3, 1)) '{------------------------------------------} N1_ = "": N2_ = "": N3_ = "" If N1 > 0 Then N1_ = EHunds(CByte(N1), ESingle()) Select Case TempI Case 1 To 12: N3_ = ESingle(TempI) Case 13 To 19: If N3 > 0 Then N3_ = Tenteen(CByte(TempI), ETens()) Case 20 To 99: N2_ = ETens(N2) If N3 > 0 Then N3_ = N2_ + "-" + ESingle(N3) N2_ = "" End If End Select OnlyPart = AddAnd(N1_, N2_, N3_, "", Lang) '{------------------------------------------} Part_ = "" If PartNum(k) > 0 Then Part_ = EParts_(Parts - k - 1) If Part_ <> "" Then Part_ = EParts_((Parts - k - 1)) End If Result1(k) = AddAnd(OnlyPart, Part_, "", "", Lang) Next k '{------------------------------------------} N1_ = AddAnd(Result1(0), Result1(1), Result1(2), "", Lang) N2_ = AddAnd(Result1(3), Result1(4), Result1(5), "", Lang) Only_ = AddAnd(N1_, N2_, "", "", Lang) Leng = Len(Only_) Only_ = AddAnd(Only_, FracS, "", " and", Lang) If Only_ <> "" Then Only_ = AddAnd(Single_, Only_, "", "", Lang) EOnly = Only_ End If End Function Function S_Only(InNum As Variant, Lang, FracType As Byte) As Variant Dim Num_ As String Dim k, Dec As Byte Dim FType As Byte If IsNull(InNum) Then S_Only = Null Exit Function End If Num_ = Str(InNum) k = InStr(1, Num_, ".", 1) If k > 0 Then Dec = Len(Num_) - k If Dec < 2 Then Dec = 2 Else Dec = 0 End If FType = FracType If FType <> 2 Then FType = 1 S_Only = B_Only(InNum, Lang, 0, Dec, "", "", 0, "", "", FType) End Function Function B_Only(InNum As Variant, Lang, Sex, Dec As Byte, Single_, Ploral_ As String, _ FSex As Byte, SFrac, PFrac As String, FracType As Byte) As Variant Dim Leng, Parts, k As Byte Dim FracVal As Double Dim Num_ As String Dim FracS As String Dim FracNum As String Dim Only As String If IsNull(InNum) Then B_Only = Null Exit Function End If Num_ = Str(InNum) If InStr(1, Num_, "E+", 1) > 0 Then Num_ = ReStr(Num_) FracVal = 0 GoTo DoProcess End If Num_ = ReFormat(Val(InNum), Dec) k = InStr(1, Num_, ".", 1) If k > 0 Then FracS = "0" & Mid(Num_, k, Dec + 1) Else FracS = "" FracVal = Val(FracS) Num_ = Trim(Str(Fix(InNum))) Do While Len(FracS) < Dec + 2 FracS = Insert(FracS, "0", 1) Loop DoProcess: If FracVal = 0 Then FracS = "" FracNum = Trim(Mid(FracS, 3, Len(FracS))) If FracS <> "" Then Select Case FracType Case 2 Select Case Lang Case vArabic: FracS = "1" & String(Dec, "0") & "/" & Format(FracNum, String(Dec, "0")) Case vEnglish: FracS = Format(FracNum, String(Dec, "0")) & "/" & "1" & String(Dec, "0") End Select Case 3 FracS = FracNum & " " & SFrac If Lang = vEnglish And CDbl(FracNum) > 1 Then FracS = FracS & "'s" Case 4 Leng = Len(FracNum) Parts = Fix((Leng + 2) / 3) For k = 1 To (Parts * 3) - Leng FracNum = Insert("0", FracNum, 1) Next k Select Case Lang Case vArabic: FracS = AOnly(FracNum, "", SFrac, PFrac, Parts, FSex, FracType) Case vEnglish: FracS = EOnly(FracNum, "", "", Parts, 0) & " " & SFrac If CDbl(FracNum) > 1 Then FracS = FracS & "'s" End Select End Select End If Leng = Len(Num_) Parts = Fix((Leng + 2) / 3) For k = 1 To (Parts * 3) - Leng Num_ = Insert("0", Num_, 1) Next k If Len(Num_) > 18 Then B_Only = InNum Exit Function End If Select Case FracType Case 1, 2 Select Case Lang Case vArabic: Only = AOnly(Num_, FracS, Single_, Ploral_, Parts, Sex, Dec) Case vEnglish: Only = EOnly(Num_, FracS, Single_ & "", Parts, Dec) End Select Case 3, 4 Select Case Lang Case vArabic: Only = AOnly(Num_, "", Single_, Ploral_, Parts, Sex, Dec) If CDbl(Num_) = 0 And FracS <> "" Then Only = "" If FracS <> "" Then Only = AddAnd(Only, FracS, "", "و ", CByte(Lang)) Case vEnglish: Only = EOnly(Num_, "", Single_ & "", Parts, Dec) If CDbl(Num_) = 0 And FracS <> "" Then Only = "" If FracS <> "" Then Only = AddAnd(Only, FracS, "", " and", CByte(Lang)) End Select End Select If Only <> "" Then Select Case Lang Case vArabic: B_Only = "فقط " & Only Case vEnglish: B_Only = Only & " only" End Select End If End Function أرجوا أن يستفيد منه الجميع و لا تنسوا صاحب الكود من الدعاء

يا شباب أنا في ورطة مع الوقت قمت بعمل شاشة تعمل كواجهة للفواتير و المطلوب مني الأن هو تفقيط الفاتورة فهل أجد عندكم كود التفقيط و لكم جزيل شكري

السلام عليكم و رحمة الله وبركاته أخي سهل بارك الله لك لردك علي و لردودك على باقي الأحوة و لكن ما سألت عنه طرح من قبل و قد رأيته و رأيت ردك في هذا الموضوع و لكن ما تم التوصل إليه فى هذا الموضوع هو نفس ما توصلت إليه و هو استخدام docmd.setwarning off و لكنها أيضاُ غير كافيه و هذا والله موضوع هام لمن يريد أن يسوق لبرامجه لتظهر بشكل احترافي بارك الله لك و للأخوة و من عنده حل أو طريقة للحل فلا يبخل بالمشاركة .. و شكراً للجميع