نجوم المشاركات

وعليكم السلام 🙂 نعم ، جوابك ، هو قصدي مما قلته انا ، اما TempVars فهو موجود في الاكسس 2007 فما فوق ، وهو جدا مفيد واستعماله جدا سهل ، ولا يحتاج الى موديول لمناداته . جعفر

1-كالعادة تسمية الورقة باللغة الأجنبية 2- اكنب في Texbox ما تـريد 3-اضغط أحد المفاتيح Enter , Tab , Any arrows Code Option Explicit Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Dim Ws As Worksheet Dim Lr% Dim My_val Dim F_rg As Range Set Ws = Sheets("Sheet_1") Lr = Ws.Cells(Rows.Count, 1).End(3).Row Ws.Range("A3:N" & Lr).Interior.ColorIndex = xlNone Select Case KeyCode Case 37 To 40, 13 My_val = TextBox1.Text Case Else Exit Sub End Select Set F_rg = Ws.Range("A2:A" & Lr).Find(My_val, lookat:=1) If F_rg Is Nothing Then Ws.Range("A3").Select Else With Ws.Range("A" & F_rg.Row) .Select .Resize(, 14).Interior.ColorIndex = 35 End With End If End Sub Flle Icluded abou_kasem.xlsm

طيب اجاوب Global AddVar As Variant Public Function GetVar() GetVar = AddVar AddVar = Empty End Function ويكتب المعيار GetVar()

ولكن عندى القليل من النصائح - تسمية الكائنات بالإنجليزية مع مراعاة عدم ترك مسافات بين الكلمات وليكن الحرف الاول مثلا كبير مثل ( AliaYusrElddin ) ذلك يسهل كثيرا مستقبلا كتابة الاكواد ولا يحدث مشاكل ان كاانت اعدادت الجاسوب لا تعتمد على العربية هذا طبعا بجوار عدم استخدام الحروف العربية داخل محرر الاكواد مطلقا وهذا ما تعلمته من استاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ @jjafferr بارك الله فى عمره وعلمه واهله - يستحسن من وجهة نظرى المتواضعة عمل دول اساسى للبيانات كما اننى افضل وضع بيانات الحضور مع الانصراف بنفس الجدول - تسمية الحقول بما يناسب الواقع او تسميتها بما يتلائم مع الية العمل ليسهل لاى من كان الفهم والتطور يعنى مثلا هنا حضرتك استخدمتى نفس الاسماء للحقول فى كل من جدول الحضور والانصراف girlid girlname dateatt

Try this File Mhoud_1980.xlsx

السلام عليكم اقدم لكم هذا النموذج البسيط لكنه يحتوي على عدة افكار وهي : 1- حقل البحث بجزء من الاسم ويمكن البحث اما في حقل الاسم او حقل المدرسة 2- زر امر يسمح بتعديل الاسم او تجميده وزر امر آخر لحقل المدرسة . زر اضافة سجل جديد الى النموذج الفرعي . ارجو ان ينال اعجابكم Database1.mdb

السلام عليكم ورحمة الله وبركاته فى احد الموضوعات تكرم استاذى الجليل و معلمى القدير و والدى الجبيب الاستاذ @jjafferr بالتطرق الى تلك الجزئية يعنى هل هذه الطريقة بديل ل TempVars وهل ممكن مثال مصغر يوضح الطريقة بارك الله فى اساتذتى الافاضل

السلام عليكم ورحمة الله اكتب هذه المعادلة فى الخلية D2"" =ROUND(C2*15%;2) ثم اسحب لآخر خلية تريدها

جدا جدا ممتاز الله يعافيك شكرا شكرا

مثال عملى Passing a variable to a query.mdb

اما اداة البحث /الاستبدال ، فيوجد لها شرح هنا جعفر

شكرا استاذ سليم على مساعدتك لى وعلى هذه الاضافة العلمية القيمة قد استفدت حقا منها وستفيدنى كثيرا فى عملى

شكرا شكرا الله يعافيك ما قصرت

وهو كذلك بارك الله فيكم اساتذتي الكرام اباجودي - جعفر جعلها الله في ميزان حسناتكما صحيح طريقة سهلة وبعيدة عن TempVars لكم مني فائق الاحترام والتقدير

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

آمين وإياكم. بإذن الله تعالى سأعمل على هذه الخاصية الجديدة لتخرج للنور في أقرب وقت.

بارك الله فيكم جميعا تم حل المشكلة وذلك عندما وجدت تكرار للكود الخاص بكلمة السر كان موجود مرتين قمت بحذف واحد منهم . والحمد لله كله تمام مرفق الكود الخاص عمل كلمة السر على هيئة نجوم حتى لا يعرفها أحد . Option Explicit Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _ ByVal dwThreadId As Long) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long Private Const EM_SETPASSWORDCHAR = &HCC Private Const WH_CBT = 5 Private Const HCBT_ACTIVATE = 5 Private Const HC_ACTION = 0 Private hHook As Long Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim RetVal Dim strClassName As String, lngBuffer As Long If lngCode < HC_ACTION Then NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam) Exit Function End If strClassName = String$(256, " ") lngBuffer = 255 If lngCode = HCBT_ACTIVATE Then RetVal = GetClassName(wParam, strClassName, lngBuffer) If Left$(strClassName, RetVal) = "#32770" Then SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0 End If End If CallNextHookEx hHook, lngCode, wParam, lParam End Function Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _ Optional YPos, Optional HelpFile, Optional Context) As String Dim lngModHwnd As Long, lngThreadID As Long lngThreadID = GetCurrentThreadId lngModHwnd = GetModuleHandle(vbNullString) hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID) InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context) UnhookWindowsHookEx hHook End Function

تمام، فتح الله لك، وإن شاء الله ممكن مع التجربة يكون هناك اقتراح للتطوير. الأيام التاريخية.docx

1- أكيد، وكالعادة القوائم والمجموعات ستكون قابلة للزيادة، والتعديل، والحذف. 2- يمكن للمستخدم أن يضيف الكلمة في أكثر من مجموعة؛ أي في أكثر من فهرس، فكلمة (تبوك، خيبر، الجعرانة) يمكنه إضافتها لمجموعة فهرس الأماكن، ويمكنه إضافتها لمجموعة فهرس الغزوات، وستظهر الكلمة في الفهرسين دون خلط ودون أي مشكلة. 3- خطر ببالي شيء مميز، وهو: عند إدخال الكلمات نطلب من المستخدم أن يحدد هل هي مشتركة أم لا؟ أي يكون هنالك مربع اختيار بعنوان [مشتركة]، إن كانت الكلمة مشتركة يقوم بتفعيل هذا المربع، وإلا يتركه غير مفعل، ثم ينقر زر إضافة لإضافة الكلمة للقائمة. الآن عند الفهرسة، عندما يختار مجموعة ما، كمجموعة الأماكن مثلاً، سنوفر له خيارات للعرض (المشتركة - غير المشتركة - الجميع "المشتركة وغير المشتركة")، إذا اختار المشتركة، تظهر له من المجموعة فقط الكلمات التي تم تحديدها على أنها مشتركة، وهكذا. الآن في الأسفل يوجد عدة خيارات، وهي: - تمييز الكلمات المختارة باللون الأصفر (وهي مفيدة لمراجعة الباحث هذه المواضع). - البدء بفهرسة كل الكلمات المختارة دفعة واحدة (وهذه ستفيده لو كان قد حدد الكلمات غير المشتركة). - البدء بالفهرسة من خلال المرور على المواضع (وهذه ستفيده لو كان قد حدد الكلمات المشتركة)، حيث أن البرنامج سيقوم بالمرور على كل كلمة، فإن أراد فهرستها نقر زر موافق، وإلا نقر زر لا، ثم ينتقل للموضع التالي، وهكذا دواليك إلى نهاية المستند. ما رأيك أخي العزيز؟

وعليكم السلام ورحمة الله تعالى وبركاته كل الشكر والتقدير لحضرتك على تلك الافكار الرائعة ...

شكرا استاذ اباجودي على تعبك معانا ربنا يحفظك الان ارجع الى المثل الصيني الذي يقول "لا تعطيني سمكة وعلمني كيف اصطاد السمكة" فأين تم التعديل استاذ

مع ملاحظة أن الألفاظ التاريخية كثيرا ما تتفق مع الأماكن، فكلمة (بدر) مثلا أحيانا يراد بها (المكان)، وأحيانا يراد بها (الغزوة) وكلمة (تبوك)، (خيبر)، (الجعرانة) كذلك، لذا قد توضع الكلمة الواحدة في فهرسين مثلا، فتوضع في (الأماكن)، و(الأيام التاريخية). فمن المستحسن جدا أن نمر على هذه المواضع موضعا موضعا للتمييز. * ثم إنه لا بد من مراجعة الباحث هذه المواضع، مع عدم الاعتماد بالشكل الكامل على الفهرسة الآلية. ومميزات هذه المرحلة الآلية: 1- تحديد كل كلمات القائمة ضمن الفهرس. 2- سرعة التنفيذ. 3- تنبيه الباحث إلى ما قد يفوته من عناصر الفهرسة. 4- إمكانية إضافة كلمات على القائمة، أو حذفها عند الحاجة، وهذا يعطي مرونة كبيرة للباحث.

تفضل ملف نموذج.xlsm

من الممكن أن نحدد من القائمة الكلمات المشتركة، بحيث يتم إدراجها في الفهرس (موضعا موضعا) ويكون هناك خيار (إدراج كل الكلمات) أو (المرور على المواضع) واحدا تلو الآخر، أما بقية الكلمات غير المشتركة -وهي الأكثر- فيتم إدراجها دفعة واحدة للفهرس. * ملحوظة: يا حبذا لو كانت هذه القائمة قابلة (للزيادة، والتعديل، والحذف).

1. وانا كذلك ، لا احبذ استخدامها ، ولكن "وللأسف" لما المبرمج يستخدم نماذج منبثقة ، فيقوم بإغلاق نموذج وفتح نموذج آخر ، فالكلام هنا ان لا تغلق النموذج الرئيسي ، وانما تجعله مخفي ، 2. لأن TempVars غير موجودة في الاكسس قبل 2007 (يعني اذا اكسس 2003 منصب على كمبيوترك ، فانه لا يعرف ما هو TempVars) ، وصيغة المرفق mdb ، مما يوحي ان الاكسس المنصب نسخة قبل 2007 🙂 3. نعم ممكن عمل موديول ، واعطاء القيمة للمتغير هناك ، ثم مناداة المتغير في كل كائنات الاكسس ، ولكن لا يمكن مناداة المتغير مباشرة في الاستعلام ، وانما يجب مناداته عن طريق موديول آخر 🙂 جعفر

ما علاقة العمود P بالعمود R ؟ لم أفهم ذلك عموما مرفق الملف بعد تعديل الشهور لتظهر القيمة العشرية وفقك الله برنامج فحص.xlsm

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

اتفضل اخوي العزيز نسخ المدى مع التحديد نسخ مدى معين.xlsm

عدلت على طريقة الاخ حسام ووصلت للمطلوب On Error GoTo MyErr Dim strFilePath As String Dim strFilePath2 As String strFilePath = "d:\mahmoud\data work\backup" strFilePath2 = "z:\Blocks_be.accdb" Dim OldFile, DBwithEXT, DBwithoutEXT, NewFile, CopyMyDB adad = strFilePath2 OldFile = adad DBwithEXT = Dir(OldFile) DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 4) If Len(Dir(strFilePath, vbDirectory)) = 0 Then MkDir strFilePath SetAttr strFilePath, vbNormal End If NewFile = strFilePath & "\Blocks_be-" & Format(Date, "yyyy-mm-dd") & "-" & Format(Now(), "Hh-Nn-ss-AMPM.") & Right(DBwithEXT, 5) CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile & """" Shell CopyMyDB, 0 MyErr: If Err.Number <> 0 Then MsgBox Err.Number & " - " & Err.Description End If وشكرا جزيلا لكم على المساعدة الاكثر من رائعة

هذا الكود Option Explicit Sub test1() Dim sh As Worksheet Dim Ro As Long Dim i%, t% Set sh = Sheets("test") With sh Ro = .Range("G" & Rows.Count).End(3).Row .Range("B31:C39").ClearContents If Ro < 51 Then Exit Sub t = 31 For i = 51 To Ro If UCase(.Range("G" & i)) = "YES" Then Range("B" & t).Value = _ Range("B" & i).Value t = t + 1 If t >= 40 Then Exit For End If Next i End With End Sub

لمعرفة ماذا تعني End(4) جرب هذا الكود Sub What_is_End4() MsgBox Sheets("Sheet1").Range("A1", Range("A1").End(4)).Address End Sub بالنسية الصفحة الثّانية هذا الكود Option Explicit Sub sum_Of_JL_Sh_2() Dim LR%, t%, m% With Sheets("Sheet2") LR = .Range("j" & Rows.Count).End(xlUp).Row For t = 5 To LR .Cells(t, "j") = _ IIf(Application.CountA(.Cells(t, "J") _ .Resize(, 3)) = 1, vbNullString, .Cells(t, "j")) Next m = .Range("j5", Range("j5").End(4)).Rows.Count t = 5 Do While t < LR With .Cells(t, "J").Resize(m, 3) .Cells(m, 1).Offset(2) = _ Application.sum(.Value) End With t = t + m + 3 Loop End With End Sub الملف مرفق My_test.xlsm

العنوان مخالف .. المنتدى عربي فاكتب بالعربية

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

شكرا لك ورفع ميزان حسناتك

يالنسية للكود الثّاني صفحة Sheet1 العامودين K & L Sub Multi_J_K() Dim LR%, t% With Sheets("Sheet1") LR = .Range("j" & Rows.Count).End(xlUp).Row For t = 1 To LR .Cells(t, "j") = _ IIf(Application.CountA(.Cells(t, "J") _ .Resize(, 3)) = 1, vbNullString, .Cells(t, "j")) Next m = .Range("j1", Range("j1").End(4)).Rows.Count t = 1 Do Until t > LR Cells(t + m + 1, "J") = _ Application.Sum(Cells(t, "J").Resize(m, 3)) t = t + m + 3 Loop End With End Sub

يرجى تعديل افضل إجابة على رد الأستاذ @husamwahab وهذا نفس ما تقدم به أستاذي الجليل على المرفق الذى يخص البحث فى ايات القران الكريم البحث فى القران الكريم.zip

ربنا يبارك لك استاذ طارق

وشكراً لك

سبق وأن وجهتك الى المطلوب هنا ايضا الاخوة هنا طلبوا شرح وافي للبرنامج بمعنى انك تشرح عمل البرنامج وكأنك تعمل على الورق والدفاتر 1- البيانات التي يتم ادخالها على كافة العمليات .. 2- والنتائج المنتظرة يجب ان تنسى اكسل كليا ، اكسس سيتم عمله من الصفر

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

السلام عليكم ورحمة الله تعالى وبركاته أقدم لكم دالة تفقيط التاريخ لن أطيل عليكم الدالة في المرفق لا تنسونا من خالص دعائكم Function DateToLettre(Dat As Date) As String ' Created By Benkhalifa ' Djemoui Alger: 23/02/2018 Dim MyDays As Variant Dim MyMonths As Variant Dim MyChif As Variant Dim Cent As String Dim Mill As String Dim i, J As Byte: J = 0 '=============================================================================================================================== MyDays = Array("اليوم الأول", "اليوم الثاني", "اليوم الثالث", _ "اليوم الرابع", "اليوم الخامس", "اليوم السادس", _ "اليوم السابع", "اليوم الثامن", "اليوم التاسع", _ "اليوم العاشر", "اليوم الحادي عشر", "اليوم الثاني عشر", _ "ليوم الثالث عشر", "اليوم الرابع عشر", "اليوم الخامس عشر", _ "اليوم السادس عشر", "اليوم السابع عشر", "اليوم الثامن عشر", _ "اليوم التاسع عشر", "اليوم العشرون", "اليوم الواحد و العشرون", _ "اليوم الثاني و العشرون", "اليوم الثالث و العشرون", "اليوم الرابع و العشرون", _ "ليوم الخامس و العشرون", "اليوم السادس و العشرون", "اليوم السابع و العشرون", _ "اليوم الثامن و العشرون", "اليوم التاسع و العشرون", "اليوم الثلاثون", _ "اليوم الواحد و الثلاثون") '=============================================================================================================================== MyMonths = Array("شهر يناير", "شهر فبراير", "شهر مارس", _ "شهر أبريل", "شهر مايو", "شهر يونيو", _ "شهر يوليو", "شهر اغسطس", "شهر سبتمبر", _ "شهر أكتوبر", "شهر نوفمبر", "شهر ديسمبر") '=============================================================================================================================== MyChif = Array("صفر", "واحد", "إثنان", "ثلاث", "أربع", "خمس", "ست", "سبع", "ثمان", "تسع", _ "عشرة", "إحدى عشر", "إثنى عشر", "ثلاثة عشر", "أربعة عشر", "خمسة عشر", "ستة عشر", "سبعة عشر", "ثمانية عشر", _ "تسعة عشر", "عشرون", "واحد و عشرون", "إثنان و عشرون", "ثلاثة و عشرون", "أربعة و عشرون", "خمسة و عشرون", "ستة و عشرون", _ "سبعة و عشرون", "ثمانية و عشرون", "تسعة عشرون", "ثلاثون", "واحد و ثلاثون", "إثنان و ثلاثون", "ثلاثة و ثلاثون", "أربعة و ثلاثون", _ "خمسة و ثلاثون", "ستة و ثلاثون", "سبعة و ثلاثون", "ثمانية و ثلاثون", "تسعة و ثلاثون", "أربعون", _ "واحد و أربعون", "إثنان و أربعون", "ثلاثة و أربعون", "أربعة و أربعون", "خمسة و أربعون", "ستة و أربعون", _ "سبعة و أربعون", "ثمانية و أربعون", "تسعة و أربعون", "خمسون", "واحد و خمسون", "إثنان و خمسون", "ثلاثة و خمسون", "أربعة و خمسون", _ "خمسة و خمسون", "ستة و خمسون", "سبعة و خمسون", "ثمانية و خمسون", "تسعة و خمسون", "ستون", "واحد و ستون", _ "إثنان و ستون", "ثلاثة و ستون", "أربعة و ستون", "خمسة و ستون", "ستة ستون", _ "سبعة و ستون", "ثمانية و ستون", "تسعة و ستون", "سبعون", "واحد و سبعون", "إثنان و سبعون", "ثلاثة و سبعون", _ "أربع و سبعون", "خمس و سبعون", "ستة و سبعون", "سبعة و سبعون", "ثمانية و سبعون", "تسعة و سبعون", "ثمانون", "واحد و ثمانون", _ "إثنان و ثمانون", "ثلاث و ثمانون", "أربعة و ثمانون", "خمسة و ثمانون", "ستة و ثمانون", "سبعة و ثمانون", _ "ثمانية و ثمانون", "تسع و ثمانون", "تسعون", "واحد و تسعون", "إثنان و تسعون", "ثلاثة و تسعون", "أربعة و تسعون", _ "خمسة و تسعون", "تسعون", "سبعة و تسعون", "ثمانية و تسعون", "تسعة و تسعون", " مائة ") '=============================================================================================================================== Do While J < 2 i = Mid$(Year(Dat), J + 1, 4) '=============================================================================================================================== If Len(i) = 4 Then Select Case i Case 1 To 999: Mill = MyChif(i) Case 1000 To 9999: Select Case Int(i / 1000) Case 1: If Format(Mid$(i, 2, 4), "000") = "000" Then Mill = " ألف" Else: Mill = " ألف و " Case 2: If Format(Mid$(i, 2, 4), "000") = "000" Then Mill = " ألفان" Else Mill = " ألفان و " Case 3 To 10: If Format(Mid$(i, 2, 4), "000") = "000" Then Mill = MyChif(Int(i / 1000)) & " آلاف" Else If Int(i / 1000) = 8 Then Mill = MyChif(Int(i / 1000)) & "ية آلاف و " Else Mill = MyChif(Int(i / 1000)) & "ة آلاف و " End Select End Select End If '=============================================================================================================================== If Len(i) = 3 Then Select Case i Case 1 To 100: Cent = MyChif(i) Case 101 To 199: Cent = " مائة و " & MyChif(i Mod 100) Case 201 To 299: Cent = " مائتان و " & MyChif(i Mod 100) Case 300 To 999: Select Case (i Mod 100) Case 0: If Format(Mid$(i, 2, 4), "00") = "00" Then Cent = MyChif(Int(i / 100)) & " مائة " Else Cent = MyChif(Int(i / 100)) & " مائة و " Case 1 To 99: Cent = MyChif(Int(i / 100)) & "مائة و " & MyChif(i Mod 100) End Select End Select End If '=============================================================================================================================== J = J + 1 Loop '=============================================================================================================================== DateToLettre = MyDays(Day(Dat) - 1) & " من " & MyMonths(Month(Dat) - 1) & " عام " & Mill & Cent End Function منقول لنشر العلم جزى الله .. المحترم الخلوق بن خليفه الجموعي بكل خير دالة تفقيط التاريخ.rar

برنامج بيع بالاكسيل vba مجاني اسم المستخدم :مدير الرقم السري:5555 برنامج الافق __.rar

جرب هذا مع ملاحظة تغير المكتبة المشار اليها بالصورة وفقا لإصدار الأوفيس لديك تعطيل النظام.mdb