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

السلام عليكم 🙂 في زمن Dos والوندوز قبل 95 ، جميع البرامج كانت ملتزمة بأن طول اسم البرنامج/الملف لا يتجاوز 8 احرف ، وصيغة البرنامج/الملف هي 3 احرف ، لذا فهي معروفة 8.3 او الاسم القصير Short FileName 🙂 في هذه الايام ، 99% من البرامج تتعامل مع Unicode (الحروف الغير انجليزية) ، ولكن لا تزال هناك بعض البرامج اللي لا تتعامل مع Unicode ، مما يجعلنا لا نستطيع استعمالها اذا كان اسم الملف او المجلد مكتوب باللغة العربية ، هذا المرفق مثال على ذلك !! حتى نستطيع التعامل مع مسميات الملفات و المجلدات باللغة العربية ، مع البرامج التي لا تدعم اللغة العربية ، يمكننا ان نغيّر صيغة الملف/المسار الى صيغة 8.3 بإستعمال هذه الدالة ، وسيعمل البرنامج : Function get8_3FullFileName(F_or_F As Integer, ByVal sFullFileName As String) As String ' ' Convert the normal path to the old DOS 8.3 path ' this solves the problem of spaces in the path ' and reading Unicode names ' ' F_or_F : File or Folder ' 1= File ' 2= Folder ' Dim FSO As Object: Set FSO = CreateObject("Scripting.FileSystemObject") If F_or_F = 1 Then get8_3FullFileName = FSO.GetFile(sFullFileName).ShortPath Else get8_3FullFileName = FSO.GetFolder(sFullFileName).ShortPath End If Debug.Print "Original File Path: " & sFullFileName Debug.Print "8.3 File Path: " & get8_3FullFileName End Function . نناديها بإرسال المسار اليها ، هكذا : a_FILE = get8_3FullFileName(1, "D:\1Jaffer_Work\1Officena.net\Combine_PDF_Files_2\ملف1" & "\" & "a.pdf") او a_FILE = get8_3FullFileName(1, Application.CurrentProject.Path & "\" & "ملف1" & "\" & "a.pdf") النتيجة D:\1JAFFE~1\1OFFIC~1.NET\COMBIN~1\10DFB~1\a.pdf او اصل المسار D:\1Jaffer_Work\Samples\sound files\sound files\عمل رائع.WAV والنتيجة D:\1JAFFE~1\Samples\SOUNDF~1\SOUNDF~1\FE9C~1.WAV . جعفر

هذه مجموعة منها ..... تفضل >>>>>>>>>>>>>>>>>>>>>>>>>>

السلام عليكم تم التعديل حسب ما تصبو إليه... aa3.rar

تفضل أخي ووافني بالرد OverTime-1.rar

وهذا كود لإنهاء مهمة أكسس، من جلبي وتصرفي: Sub Kill_msAccess() Dim oServ As Object Dim cProc As Variant Dim oProc As Object Set oServ = GetObject("winmgmts:") Set cProc = oServ.ExecQuery("Select * from Win32_Process") For Each oProc In cProc 'Rename MSACCESS.EXE in the line below with the process that you need to Terminate. 'NOTE: It is 'case sensitive If oProc.Name = "MSACCESS.EXE" Then MsgBox "KILL" 'used to display a message for testing pur oProc.Terminate 'kill exe End If Next End Sub

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

اخي احمد لتأكيد ان الملف لم يكن به مشكله في تشغيل الماكرو انما المشكله في اعدادات الماكرو لديك هذا فيديو يوضح هذا show.zip

اخي اسف ليس لدي الوقت لشرح المعادلة يمكنك البحث في الانترنيت فهو متوفر في عدة اماكن بالصوت والصورة تفضل اخي تم اعادة تعديل الملف وتنسيقه مع تعديل بسيط داخل هدا الجزء من الكود لديك فهو يقوم بافراغ الخلابا الموجود بها المعادلات . Sheets("Input").Range("A6:A36,D6:F36,O6:S36,AA6:AE36").Select Selection.ClearContents وهدا مثال لتجربة العمل على الملف https://streamable.com/xnrgeb بالتوفيق............ Payroll123-3-2020 - Copy(4).xlsm

السلام عليكم 🙂 بالاضافة الى ميزات الاكسس الشخصية ، فيه امكانية مخاطبة البرامج الاخرى بعدة طرق ، احدها عن طريق Command line ، بحيث يمكننا ان نرسل اوامر من الاكسس الى هذا البرنامج الذي يقبل الاوامر من Command line . البرنامج pdftk (في المرفق) احد هذه البرامج : https://www.pdflabs.com/tools/pdftk-the-pdf-toolkit/ المرفق فيه برنامج اكسس وملف a.pdf و b.pdf ، وبزر من الاكسس ، سيتم دمج الملفين الى ملف ab.pdf ، وفي المرفق ملف الاوامر التي يقبلها برنامج pdftk . البرنامج يستطيع التعامل مع ملفات pdf بعدة طرق ، لذلك وجب قراءة ملف الاوامر 🙂 وهذا هو الكود: Private Sub cmd_combine_Click() 'Merge Two or More PDFs into a New Document 'pdftk 1.pdf 2.pdf 3.pdf cat output 123.pdf Dim pdftk_File As String Dim a_FILE As String Dim b_FILE As String Dim ab_FILE As String Dim Command_Line As String pdftk_File = Chr(34) & Application.CurrentProject.Path & "\" & "pdftk" & Chr(34) a_FILE = Chr(34) & Application.CurrentProject.Path & "\" & "a.pdf" & Chr(34) b_FILE = Chr(34) & Application.CurrentProject.Path & "\" & "b.pdf" & Chr(34) ab_FILE = Chr(34) & Application.CurrentProject.Path & "\" & "ab.pdf" & Chr(34) Command_Line = pdftk_File & " " Command_Line = Command_Line & a_FILE & " " Command_Line = Command_Line & b_FILE & " " Command_Line = Command_Line & "cat output" & " " Command_Line = Command_Line & ab_FILE 'Debug.Print Command_Line Shell_n_Wait Command_Line, vbHide End Sub جعفر اعتقد عندي هذا الملف من سنة 2009 --------------------------------------------------------------- تعديل 31-10-2019 : - استخدام الوحدة النمطية Shell_n_Wait والتي تقبل حروف unicode - utf-8 ، من https://github.com/xxdoc/vb6-Shell-Wait/blob/master/Shell %26 Wait v2/modShellWait.bas http://www.vbforums.com/showthread.php?700373-VB6-Shell-amp-Wait&p=4288285&viewfull=1#post4288285 - تم تغليف مسار الملفات بالاشارة " ، وذلك لحل مشكلة وجود مسافات في اسم المسار او الملف ، - تم تفكيك خط الامر الى مكونات اصغر ، لسهولة تغيير اي جزء منه. --------------------------------------------------------------- تعديل 15-01-2023 : يمكننا استعمال الاسم القصير Short FileName للتغلب على مشكلة اللغة العربية في استعمال هذا البرنامج 🙂 يصبح الكود: Private Sub cmd_combine_Click() On Error GoTo err_cmd_combine_Click: 'Merge Two or More PDFs into a New Document 'pdftk 1.pdf 2.pdf 3.pdf cat output 123.pdf Dim pdftk_File As String Dim a_FILE As String Dim b_FILE As String Dim ab_FILE As String Dim Command_Line As String pdftk_File = Chr(34) & Application.CurrentProject.Path & "\" & "pdftk" & Chr(34) 'File 'a_FILE = Chr(34) & Application.CurrentProject.Path & "\" & "a.pdf" & Chr(34) a_FILE = Chr(34) & get8_3FullFileName(1, Application.CurrentProject.Path & "\" & "ملف1" & "\" & "a.pdf") & Chr(34) b_FILE = Chr(34) & Application.CurrentProject.Path & "\" & "b.pdf" & Chr(34) 'Folder 'ab_FILE = Chr(34) & Application.CurrentProject.Path & "\" & "ab.pdf" & Chr(34) ab_FILE = get8_3FullFileName(2, Application.CurrentProject.Path & "\" & "المجلد النهائي") & "\" & "ab.pdf" Kill ab_FILE ab_FILE = Chr(34) & ab_FILE & Chr(34) Command_Line = pdftk_File & " " Command_Line = Command_Line & a_FILE & " " Command_Line = Command_Line & b_FILE & " " Command_Line = Command_Line & "cat output" & " " Command_Line = Command_Line & ab_FILE 'Debug.Print Command_Line Shell_n_Wait Command_Line, vbHide Exit_cmd_combine_Click: Exit Sub err_cmd_combine_Click: If Err.Number = 53 Then 'file not for for deletion Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description Resume Exit_cmd_combine_Click End If End Sub . وهذه الدالة التي يتم مناداتها لتغيير المسار الى 8.3 Function get8_3FullFileName(F_or_F As Integer, ByVal sFullFileName As String) As String ' ' Convert the normal path to the old DOS 8.3 path ' this solves the problem of spaces in the path ' and reading Unicode names ' ' F_or_F : File or Folder ' 1= File ' 2= Folder ' Dim FSO As Object: Set FSO = CreateObject("Scripting.FileSystemObject") If F_or_F = 1 Then get8_3FullFileName = FSO.GetFile(sFullFileName).ShortPath Else get8_3FullFileName = FSO.GetFolder(sFullFileName).ShortPath End If Debug.Print "Original File Path: " & sFullFileName Debug.Print "8.3 File Path: " & get8_3FullFileName End Function . والمرفق Combine_PDF_Files_83.zip فيه المثال اعلاه 🙂 Combine_PDF_Files_2.zip pdftk_2.02.zip Combine_PDF_Files_83.zip

وعليكم السلام 🙂 اذا قصدك بالخلفية ، عمل علامة مائية WaterMark ، فنعم ممكن عن طريق ملفين pdf ، وفي المرفق ملف نص txt فيه جميع الاوامر الممكن استعمالها مع البرنامج pdftk المرفق 🙂 جعفر

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

جزاكم الله خيرا وبارك الله فى عمركم

ما اعطيتني رقم الباسوورد مال الجماعة مالك علشان أشبك معاك على طول 😁 جالس أطور مشروع تحديث ال FE التلقائي ونجحت العملية ولله الحمد .. بحاول أنزله قريبا إن شاء الله .. 😊

تقصد بهذه الصورة .....

السلام عليكم تم التوصل الى الكود باقتباس من احد اعمال العلامة خبور تم رفع الشيت بالكود للاستفادة وشكرا لكم Private Sub CommandButton1_Click() ' أمر ترحيل بيانات Dim LR As Long Dim Adr As String Dim r As Integer, c As Integer ''''''''''''''''''''''''''''''' With Sh1 LR = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 End With '''''''''' For r = 1 To 10 Adr = Cells(r, 1).Address(0, 0) For c = 1 To 5 Adr = Cells(r, c).Address(0, 0) Sh1.Range("A" & LR).Cells(r, c).Value = Me.Controls(Adr).Value Next Next '''''' End Sub Book101Add.xlsm

السلام عليكم 🙂 في المشاركة الاولى ، تم اضافة خاصية القراءة من مسار المسميات باللغة العربية ، بتحويل الاسم/المسار الى صيغة 8.3 🙂 جعفر

العفو أخي حمدي .. تحياتي لك 🙂🌹

عظم الله اجركم ورحم الله ميتكم اللهم باعد بينه وبين خطاياه كما باعدت بين المشرق والمغرب اللهم نقه من خطاياه كما ينقى الثوب الابيض من الدنس اللهم اغسله من خطاياه بالماء والثلج والبرد اللهم اجعله في عليين

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

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

لله وإنّا إليه راجعون اللهم أغفر له وارحمه واسكنه فسيح جناتك اللهم ادخله الفردوس الأعلى من الجنة إختر كأفضل إجابة

حياك الله اخي الحبيب @ابوبسمله جزاك الله خيرا

السلام عليكم ورحمه الله مشاركه مع اخى واستاذى @kanory اطلع ع الرابط التالى ايضا

بعد مراجعة الكود وجدت أن rs.MoveNext متكررة مرتين .. أحذف الأولى حسب الصورة التالية :

وعليكم السلام ورحجمة الله وبركاته 🙂 استبدل هذه : بهذه : adad = CurrentProject.Path & "\" & Me.TextBoxName

@ابو جودي انا لله وانا اليه راجعون ، الله يغفرله ويرحمه ويسكنه فسيح جناته ويلهمكم الصبر والسلوان وعظم الله أجركم.

"يَا أَيَّتُهَا النَّفْسُ الْمُطْمَئِنَّةُ ارْجِعِي إِلَى رَبِّكِ رَاضِيَةً مَرْضِيَّةً فَادْخُلِي فِي عِبَادِي وَادْخُلِي جَنَّتِي " الاح العزيز المهندس / ابا جودى نقول لك مثل ما قال رسول الله صل الله عليه وسلم: لله ما أَخذ، وله ما أعْطى، وكل شيءٍ عندَه بِأجلٍ مسَمى، فَلتصبِر وَلتَحْتسِب، وندعو الله لميتكم بالرحمة الواسعة والمغفرة الشاملة وأن يلهمكم الصبر ويجبر قلوبكم، أحسن الله عزاءك. إنّا لله وإنّا إليه راجعون.

اللهم أبدله دارا خيرا من داره و أهلا خيرا من أهله و أدخله الجنة و أعذه من عذاب القبر ومن عذاب النار”. “اللهم ارحمه فوق الأرض و تحت الأرض و يوم العرض عليك اللهم قهِ عذاب يوم تبعث عبادك”. “اللهم أنزل نوراً من نورك عليه”. “اللهم نور له قبره و آنس وحشته ووسع مدخله اللهم اغفر له وارحمه، وارفع درجته، وأعظم أجره، وأتمم نوره، وأفسح له في قبره، وألحقه بنبيه” . ” اللهم أنت ربنا وربه، خلقته ورزقته، أحييته وكفيته، فاغفر لنا وله..آمين .. آمين.. آمين عظم الله اجرك استاذنا ابو جودي ... وغفر الله لموتانا وموتاكم وألهمكم الصبر والسلوان انا لله وإنا اليه راجعون

عظم الله اجركم ورحم الله ميتكم والهمكم وذويكم الصبر والسلوان. انا لله وانا اليه راجعون

غفر الله له واسكنه فسيح جناته ويلهم أهله وذويه الصبر والسلوان

(إنَّا للهِ وإنَّا إليه راجعونَ) اللهم ارحمه. (اللَّهمَّ اغفِرْ له وارحَمْه واعفُ عنه وأكرِمْ منزلَه وأوسِعْ مُدخَلَه واغسِلْه بالماءِ والثَّلجِ والبَردِ ونقِّه مِن الخطايا كما يُنقَّى الثوبُ الأبيضُ مِن الدَّنسِ لِلَّهِ ما أخَذَ وله ما أعْطَى، وكُلُّ شيءٍ عِنْدَهُ بأَجَلٍ مُسَمًّى، فَمُرْهَا فَلْتَصْبِرْ ولْتَحْتَسِبْ لا حول ولا قوة الا بالله العلي العظيم،،، لله ما أخذ وله ما أعطى وكل شيء عنده بأجل مسمى نسأل الله له الرحمة والمغفرة والثبات عند الحساب،، 🤲 عظم الله اجركم أخي العزيز أبا جودي

اخي العزيز ابو جودي إنّا لله وإنّا إليه راجعون رحمه الله وآجرك. حسن الله عزاكم فيه، وعظَّم لكم الأجور، وألهمكم التسليم للمقدور، نقول جميعاً كما قال الصابرون إنّا لله وإنّا إليه راجعون.٠

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

البقاء والدوام لله وحده اللهم اغفر له وارحمه واسكنه فسيح جناتك عظم الله اجركم ورحم ميتكم واسكنه الفردوس الأعلى من الجنة

لله ما أعطى ولله ما أخذ إنا لله وإنا إليه راجعون. عظم الله اجركم ورحم الله ميتكم والهمكم وذويكم الصبر والسلوان.

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

اخي العزيز ابا جودي عظم الله اجركم في والدكم وأحسن عزاءكم وألهمكم الصبر والسلوان انا لله وانا اليه راجعون اللهم اغفر له وارحمه واسكنه الفردوس الأعلى من الجنة

(إنَّا للهِ وإنَّا إليه راجعونَ) اللهم ارحمه. (اللَّهمَّ اغفِرْ له وارحَمْه واعفُ عنه وأكرِمْ منزلَه وأوسِعْ مُدخَلَه واغسِلْه بالماءِ والثَّلجِ والبَردِ ونقِّه مِن الخطايا كما يُنقَّى الثوبُ الأبيضُ مِن الدَّنسِ لِلَّهِ ما أخَذَ وله ما أعْطَى، وكُلُّ شيءٍ عِنْدَهُ بأَجَلٍ مُسَمًّى، فَمُرْهَا فَلْتَصْبِرْ ولْتَحْتَسِبْ لا حول ولا قوة الا بالله العلي العظيم،،، لله ما أخذ وله ما أعطى وكل شيء عنده بأجل مسمى نسأل الله له الرحمة والمغفرة والثبات عند الحساب. عظم الله اجركم أستاذي العزيز أبا جودي

البقاء والدوام لله ربنا يرحمه ويغفر له ويسمحه ونشاطركم الاحزان

انا لله وانا اليه راجعون اللَّهمَّ اغفرْ لَهُ وارحمهُ ، وعافِهِ واعفُ عنهُ ، وأكْرِم نُزَلَهُ ، ووسِّع مُدَخلَهُ ، واغسلْهُ بالماءِ والثَّلجِ والبَردِ ، ونقِّهِ منَ الخطايا كما نقَّيتَ الثَّوبَ الأبيضَ منَ الدَّنسِ ، وأبدِلهُ دارًا خَيرًا مِن دارِهِ ، وأهلًا خَيرًا مِن أهلِهِ ، وزَوجًا خَيرًا مِن زَوجِهِ ، وأدخِلهُ الجنَّةَ ونجِّهِ منَ النَّارِ وأَعِذْهُ مِن عذابِ القبرِ

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

لله ما أعطى ولله ما أخذ إنا لله وإنا إليه راجعون عظم الله اجركم ورحم الله ميتكم والهمكم وذويكم الصبر والسلوان

الاستاذ @ابو جودي (إنَّا للهِ وإنَّا إليه راجعونَ) اللهم ارحمه. (اللَّهمَّ اغفِرْ له وارحَمْه واعفُ عنه وأكرِمْ منزلَه وأوسِعْ مُدخَلَه واغسِلْه بالماءِ والثَّلجِ والبَردِ ونقِّه مِن الخطايا كما يُنقَّى الثوبُ الأبيضُ مِن الدَّنسِ لِلَّهِ ما أخَذَ وله ما أعْطَى، وكُلُّ شيءٍ عِنْدَهُ بأَجَلٍ مُسَمًّى، فَمُرْهَا فَلْتَصْبِرْ ولْتَحْتَسِبْ

الاستاذ @ابو جودي لله ما أعطى ولله ما أخذ إنا لله وإنا إليه راجعون. عظم الله اجركم ورحم الله ميتكم والهمكم وذويكم الصبر والسلوان.

الاستاذ @ابو جودي لله ما أعطى ولله ما أخذ إنا لله وإنا إليه راجعون. عظم الله اجركم ورحم الله ميتكم والهمكم وذويكم الصبر والسلوان.

(إنَّا للهِ وإنَّا إليه راجعونَ) اللهم ارحمه. (اللَّهمَّ اغفِرْ له وارحَمْه واعفُ عنه وأكرِمْ منزلَه وأوسِعْ مُدخَلَه واغسِلْه بالماءِ والثَّلجِ والبَردِ ونقِّه مِن الخطايا كما يُنقَّى الثوبُ الأبيضُ مِن الدَّنسِ لِلَّهِ ما أخَذَ وله ما أعْطَى، وكُلُّ شيءٍ عِنْدَهُ بأَجَلٍ مُسَمًّى، فَمُرْهَا فَلْتَصْبِرْ ولْتَحْتَسِبْ

امين اللهم اغفر له وارحمه، وعافه واعف عنه، وأكرم نزله، ووسع مدخله، واغسله بالماء والثلج والبرد، ونقه من الخطايا كما ينقى الثوب الأبيض من الدنس، وأبدله دارا خيرا من داره، وأهلا خيرا من أهله، وزوجا خيرا من زوجه، وأدخله الجنة، وأعذه من عذاب القبر، ومن عذاب النار

لا حول ولا قوة الا بالله العلي العظيم،،، لله ما أخذ وله ما أعطى وكل شيء عنده بأجل مسمى نسأل الله له الرحمة والمغفرة والثبات عند الحساب،، 🤲 عظم الله اجركم أخي العزيز أبا جودي

لا حول ولا قوة الا بالله الله يرحمه ويغفر له ويسكنه فسيح جناته ويلهم اهله وذويه الصبر والسلون ان لله وان اليه راجعون

معايير التقرير (التاريخ) ...... report parameters غالبا ما نستخدم حصر نتائج التقرير بين تاريخين ، تاريخ بداية و تاريخ نهاية ، وكل له فيها طريقة ، اريد انشاء نموذج لتمرير التواريخ للتقرير ، التقارير عندي يومية واسبوعية وشهرية وسنوية (لنفس التقرير) ، اريد طريقة بحيث لا اضطر لكتابة التواريخ وإحتساب الفترات ، أو استخدام التقويم ؟!! بسيطة ... ننشيئ النموذج بمربعي نص الاول txtdatefrom لتاريخ البداية ، والثاني txtDateTo لتاريخ النهاية ، ثم ننشيئ أربعة أزرار أمر : الاول لضبط نطاق التاريخ للتقرير اليومي ، ونسميه cmdtoday ، ونضع خلفه الكود Private Sub cmdtoday_Click() Me!txtdatefrom = Date Me!txtDateTo = Date End Sub الثاني لضبط نطاق التاريخ الاسبوعي ، ونسميه cmdweek ، ونضع خلفه الكود Private Sub cmdweek_Click() Dim today today = Weekday(Date) Me!txtdatefrom = DateAdd("d", (today * -1) + 2, Date) Me!txtDateTo = DateAdd("d", 6 - today, Date) End Sub الثالث لضبط نطاق التاريخ الشهري ، ونسميه cmdmonth ، ونضع خلفه الكود Private Sub cmdmonth_Click() Me!txtdatefrom = CDate("01/" & Month(Date) & "/" & Year(Date)) Me!txtDateTo = DateAdd("d", -1, DateAdd("m", 1, Me!txtdatefrom)) End Sub والرابع لضبط نطاق التاريخ السنوي ، ونسميه cmdyear ، ونضع خلفه الكود Private Sub cmdyear_Click() Me!txtdatefrom = CDate("01/01/" & Year(Date)) Me!txtDateTo = DateAdd("d", -1, DateAdd("yyyy", 1, Me!txtdatefrom)) End Sub وأخيرا ننشيئ زر أمر للتأكد من ادخال البيانات الى الحقلين المعنيين ، ثم للطباعة أو الغاء الامر ، ونسميه cmdReport ، ونضع خلفه الكود Private Sub cmdReport_Click() On Error GoTo Err_cmdReport_Click Dim stDocName As String stDocName = "rptDateParameterReport" If Len(Me.txtdatefrom & vbNullString) = 0 Or Len(Me.txtDateTo & vbNullString) = 0 Then MsgBox "Please ensure that a report date range is entered into the form", _ vbInformation, "Required Data..." Exit Sub Else DoCmd.OpenReport stDocName, acPreview End If Exit_cmdReport_Click: Exit Sub Err_cmdReport_Click: MsgBox Err.Description Resume Exit_cmdReport_Click End Sub وكفى ... وصحتين وعافية ... جرب ..........