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

السلام عليكم ورحمة الله و بركاته

شكرأ أخي رضوان لتفاعلك معي

و لكن يا صديقي المشكلة ليسة في تكبير الشاشة لاستخدم الأمر الذي ذكرته

أو حتى أن استخدم ماكروا لذلك أرجوا أن تجرب ذلك عملياً و ستعرف ما أقصد

و شكراً لك :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

و لكنها أيضاُ غير كافيه

و هذا والله موضوع هام لمن يريد أن يسوق لبرامجه لتظهر بشكل احترافي

بارك الله لك و للأخوة

و من عنده حل أو طريقة للحل فلا يبخل بالمشاركة ..

و شكراً للجميع