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

اليك ما طلبت عملنا جدول اولا بها ثلاث خقول فقط الاول اي دي للتسلسل والثاني HIGH والثالث LOW وبعدين عملنا استعلام واضفنا حقولباسماء الاخرى P , X , SELL FROM و ... الخ وكل واحد منها عطيتناه شروط وكل شروط كان فقط + و / و - و * مع NZ وبعدين عملنا نموژج على ژاك الاستعلام شوف ووافيني بالنتيجه‌ Database3.rar

السلام عليكم أستاذ علي تم تنظيف البرنامج من مخلفات تجاربي السابقة ، وهذه النتيجة بعد عمل الفاصل بين الاسابيع: . وهذا كود المسافة بعد يوم الخميس Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer) If Me.DayName = "الخميس" Then Me.Detail.Height = 0.5 * 1440 Else Me.Detail.Height = Me.DayName.Height End If End Sub صافي يا لبن جعفر 459.4.AbsentLate-10-12-2016.accdb.zip

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

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

تتميز الفكره بادخال حركات المخزن على صفحات الاكسيل مباشره لا على نوافذ حيث السرعه ستكون اكبر ومن الممكن انزال البيانات Copy و PAST اهدى اليكم الفكره لكل اصدقاء المنتدى مع المطالبه لكل مفكرى المنتدى باى اضافات ممكنه وذلك للافاده للجميع كارته مخزن.rar

طريقة عمل شاشة ( فورم ) ادخال وترحيل واستعلام وتعديل !! خطوة خطوة السلام عليكم اساتذة المنتدي وخبراؤه الكبار الاخوة الافاضل اعلم ان هذه الموضوعات قد قتلت بحثا وطلبا واجابة من الاعضاء وهناك امثلة كثيرة للاساتذة الافاضل الكبار والذي لايصل علمنا او ما لدينا كله الي ذرة واحدة من علمهم ولكني اردت ان اجعل المواضيع الاساسية في عمل اي برنامج في متناول الجميع بطريقة بسيطة وسهله اكثر ما يكون من خلال هذه السلسلة ( اعانني الله علي اكمالها كما ينبغي ) وقصدت ان يكون الموضوع بعنوان واضح ليستفيد منه الجميع عند البحث وسأقدم الشرح بطريقة الفيديو والاكسيل والورد احياناً (((( الدرس الاول )))) شاشة ( فورم ) لادخال بيانات والقيام بتسجيل وترحيل هذه البيانات الي صفحة الاكسيل و الاستعلام من خلالها عن طريق نفس الفورم والتعديل ايضا في البيانات في حالة ما اردنا التعديل في بيان قد سبق ادخاله وطبعاً والاكيد كله من علمكم اساتذتي الكرام الاجلاء وفي الدرس القادم سنتعرف علي بعض الاكواد المعاونة لشاشة الادخال او بمعني ادق اكواد نحتاجها مع شاشة الادخال مثل (تنسيق التكست بوكس ، الترقيم التلقائي في تكست معين ، تنسيق التاريخ في التكست بوكس .... ) واي استفسار .... في الخدمة دائما ... واي شئ غير واضح في الشرح علي استعداد تام لشرحه مرة اخري ومرات اخري واليكم ايضا في المرفقات : 1- ملف اكسيل به الاكواد والشرح هذه المرة داخل الكود ( تم شرح الكود سطر سطر بطريقة وافية وبسيطة جدا داخل الكود نفسه ) 2- عدد ( 3 ) ملف فيديو يشرح طريقة التصميم واضافة الاكواد وكذلك مشاهدة النتيجة جزاكم الله خيرا اساتذتنا اكسيل ..طريقة عمل شاشة ادخال 1.rar فيديو 1 .. طريقة عمل شاشة ادخال 1.rar الملف الفيديو الثاني والثالث في المشاركة التالية حيث لم يمكنني اضافتهم هنا

اعزائي رواد المنتدى الفاضل اقدم لكم فكرة وطريقة في تحويل التاريخ الميلادي الى تاريخ ام القرى وهو الى حد ما التاريخ الهجري . وذلك باستخدام مكتبات الاكسل ! كما انه وعد مني للاخ والأستاذ أبو خليل وفي احد المناقشات وجب على الوفاء به ! وقد كانت هذه الفكرة طرحتها في احد المنتديات الشقيقة ولكن بدون مثال او تنفيذ . اترككم مع المثال املا الاستفادة منه وطرح آراؤكم ومقترحاتكم البناءة ! لكم خالص تحياتي Private Sub أمر4_Click() ''رمهان '' اوفيسنا ''abc_2_me@hotmail.com '' هدية للاخ ابو خليل Set xl = CreateObject("Excel.Sheet") xl.Application.Range("A1").Value = CDate(t2) xl.Application.Range("A1").NumberFormat = "[$-1170000]B2yyyy-mm-dd;@" t1 = xl.Application.Range("A1").Text xl.Application.Quit Set xl = Nothing End Sub رمهان - ام القرى.rar

السلام عليكم اساتذة المنتدي وخبراؤه الكبار الاخوة الافاضل اعلم ان هذا الموضوع قد قتل بحثا وطلبا واجابة من الاعضاء وهناك امثلة كثيرة للاساتذة الافاضل الكبار والذي لايصل علمنا او ما لدينا كله الي ذرة واحدة من علمهم ولكن هو طلب لأحد الاعضاء ( الاخ الكريم / alredha ) ولكني اردت ان اجعله موضوع بعنوان واضح ليستفيد من الجميع عند البحث وسأقدم الشرح بطريقة الفيديو والاكسيل والورد احياناً (((( الدرس الاول )))) شاشة افتتاحية باسم مستخدم ورقم سري ولايظهر الاكسيل الا بعد اعطاء الشاشة البيانات الصحيحة وطبعاً والاكيد كله من علمكم اساتذتي الكرام وفي الدرس القادم سنتعرف علي طريقة عمل اكواد الشاشة لتعمل معنا علي اي برنامج لدينا او اي برنامج سنقوم بتصميمه فيما بعد جزاكم الله خيرا اساتذتنا طريقة عمل الشاشة الافتتاحية شرح علي الورد1.rar شرح عمل شاشة افتتاحية فيديو1.rar طريقة عمل الشاشة الافتتاحية اكسيل1.rar

قم باسترداد النموذج الى ملف برنامجك وضع كود استدعاءه تحت صوره عند حدث النقر المزدوج او ما تحب Shift.zip Shift.zip

السلام عليكم ورحمة الله لا يمكن تنفيذ هذه الأوامر في الكود على ورقة محمية... لحل المسألة يمكن إضافة أمر "إلغاء الحماية" قبل هذه الأوامر ثم بأمر آخر بعدها لـ "إعادة الحماية" بالكلمة السرية نفسها... * أمر "إلغاء الحماية" هو : ActiveSheet.UnProtect Password:="YourPass" * وأمر "إعادة الحماية" هو : ActiveSheet.Protect Password:="YourPass" بن علية

أخى الكريم يمكنك حماية الأكواد بكلمة مرور ـ كما يلى 1 ـ قم بالدخول إلى محرر الأكواد بالضغط على Alt + F11 علىAlt + F11 2 ـ من قائمة Tools 3 ـ اختر منها VBProject Properties 4 ـ نشط التاب Protection 5 ـ نشط مربع الحوار Lock Project 6 ـ أدخل الباسورد الخاص بك لحماية الأكواد ثم أعد كتابة أسفل منة مرة أخرى للتأكيد ثم أضغط OK 7 ـ قم بحفظ الملف وأغلقة وارجع افتحه تانى وادخل على محرر الأكواد وحاول تفتح أة موديول أو فورم ... ماذا تلاحظ ؟؟؟ أتمنى أن يكون الشرح أدى الغرض المطلوب تقبل تحياتى

أخى فى الله الأستاذ // أبو الحسن بالمرفقات الملف ( بالضغط على السهم تفتح القائمة المنسدلة لـ ComboBox1 ) اختر منها كود الموظف مرتبات تم التعديل_2.rar

فورم لواجهة شيت كنترول حديثة الفيديو رقم 36 https://up.top4top.net/downloadf-1109s18541-rar.html واجه حديثة لشيت كنترول الدرس 35.rar

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

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

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

ربنا يبارك لك استاذ خالد ...

الأخ الكريماحمد 505 السلام عليكم الكود الموجود بالملف يعمل بنسبة 100% ولكن الخطأ لا بد من ان تكتب السيريال نمبر بالعمود A فى الصف المراد التحديث له أرجو ان يفى ذلك بالمطلوب

أخى فى الله الأستاذ // أبو الحسن على حد علمى لأ ، يجب ان يكون البحث مطابق

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

1. اعمل استعلام ، وادخل فيه اي حقلين من اي جدول ، احدهما فيه بيانات ، والاخر مافيه بيانات ، اذا استعمل '*' Like في الحقل الذي ليس فيه بيانات ، سترى انه لا تحصل على سجلات اصلا ، مع ان الحقل الآخر فيه بيانات ، هذه كانت مشكلتك ، لأنه لما تستعمل المعيار Peinture ، سترى ان الحقل Heure مثلا ليس به بيانات ، واذا استعملت المعيار '*' Like عليه ، فلن تحصل على اي نتيجة. لذا ، كان لازم نتخلص من معايير '*' Like للحقول التي لا توجد بها معايير ، لذا فقمت بحذفها ، وهذا لا يؤثر على نتائج الاستعلام. 2. ونتيجة الى حذف '*' Like للحقول التي ليست بها معايير ، اصبح لدينا الكثير من " & "And" & " الزائدة ، والتي تمنع من عمل SQL الاستعلام ، فاضطررت الى حذفها ، 3. بقية And الاولى ، والتي كان يجب حذفها كذلك ، فاسهل سطر لحذفها كان هذا جعفر

السلام عليكم بل الخطأ في معادله اللون الاحمر ومعادله اللون الاصفر -- لان اللون الاصفر هنا يحدد التواريخ التى هي اقل من تاريخ اليوم بعدد الايام الموضوعه في حين ان الصحيح ان يحدد التواريخ التى اكبر من تاريخ اليوم بعدد الايام الموضوعه ليكون اللون الاصفر بمثابه انذار بقرب ميعاد الانتهاء والتواريخ الإقل مطبق عليها اللون الاحمر تنســــــــــــــــــــــقات-نسخة.rar

نعم ، كانت هناك مشكلة عندما الحقل يكون فارغ ، والمعيار '*' Like ، فلا تحصل على نتائج تم تغيير الكود الى: Function SearchCriteria() Dim strProject As String Dim strProfil, strMachine, strRepere, strDone, strTime, strUnits As String Dim strFirstDate, strLastDate As Date Dim Task As String Dim strCriteria As String '.................................................................................. If IsNull(Me.cboTime) Then Else strTime = " And [Heure] = '" & Me.cboTime & "' " End If '................................................................................. If IsNull(Me.cboProject) Then Else strProject = " And [N° BS] = '" & Me.cboProject & "' " End If '................................................................................. If IsNull(Me.cboMachine) Then Else strMachine = " And [Machine] = '" & Me.cboMachine & "' " End If '................................................................................. If IsNull(Me.cboProfil) Then Else strProfil = " And [Désignation] = '" & Me.cboProfil & "' " End If '................................................................................ If IsNull(Me.cboRepere) Then Else strRepere = " And [Repères] = '" & Me.cboRepere & "' " End If '................................................................................ If IsNull(Me.cboDone) Then Else strDone = " And [Done] = '" & Me.cboDone & "' " End If '................................................................................ If IsNull(Me.txtFirstDate) Or IsNull(Me.txtLastDate) Then Else strFirstDate = " And [LaDate]>= #" & Format(txtFirstDate, "mm/dd/yyyy") & "#" _ & " And [LaDate] <= #" & Format(txtLastDate, "mm/dd/yyyy") & "#" End If '................................................................................ If IsNull(Me.cboUnits) Then Else strUnits = " And [Units from] = '" & Me.cboUnits & "' " End If '................................................................................ strCriteria = strProject & strMachine & strProfil & strRepere & strDone & strFirstDate & strTime & strUnits Task = "select * from tblRealisation where " & strCriteria 'Debug.Print Replace(Task, "where And", "where") Me.RealisationSubForm.Form.RecordSource = Replace(Task, "where And", "where") Me.RealisationSubForm.Form.Requery End Function جعفر

اشكرك يا استاذ خالد ، هو هذا المطلوب بالضبط ، وشرحك جميل الله يجزاك الجنة

شكرا جزيلا اخي شفان على المداخله والتوضيح اختي maya8 وكذلك المرفق غير موجود ، فالرابط الذي وضعتيه في مشاركتك لا يعمل لكي تضعي مرفقك في المشاركة ، فيجب عليكي 1. ضغط ملف الاكسس بصيغة rar او zip ، 2. واما الصور بصيغة jpg او gif او bmp او png فلا تحتاج الى ضغط ، 3. تستطيعين ارفاق مجموعة من الملفات والصور ، بحيث لا يتجاوز مجموع حجمها (الحد الاقصى) ، 4. طريقة ارفاق المرفقات ، وكما هو موضح في اسفل المشاركة (اسحب الملفات الي هنا لارفقاها ، او اختر ملف...) سحب المرفقات الى المنطقة المظلله اسفل المشاركة ، النقر على كلمة "اختر ملف..." (المنطقة المظلله اسفل المشاركة). جعفر

وعليكم السلام تفضل: Private Sub cmd_Open_the_File_from_Destination_Click() Dim strFilePath As String Source = DLookup("[attachemnts bath]", "bath", "[ID] = 1") Destination = DLookup("[attachemnts bath]", "bath", "[ID] = 2") strFilePath = Destination & "\" & Me.ID & ".PDF" If Dir(Source & "\" & Me.ID & ".PDF") <> "" Then FileCopy Source & "\" & Me.ID & ".PDF", Destination & "\" & Me.ID & ".PDF" 'give the slow PCs wait time until copying is completed PauseTime = 2 ' Set duration. Start = Timer ' Set start time. Do While Timer < Start + PauseTime DoEvents ' Yield to other processes. Loop Application.FollowHyperlink strFilePath Else MsgBox "There are no GAS Certificates saved for this Property. Please Add or Scan a new document!" End If End Sub Private Sub Form_Load() Dim strFilePath As String Destination = DLookup("[attachemnts bath]", "bath", "[ID] = 2") strFilePath = Destination & "\" & Me.ID & ".PDF" If Dir(strFilePath) <> "" Then 'الملف موجود، غير لون خلفية الزر الى اخضر Me.cmd_Open_the_File_from_Destination.BackColor = RGB(0, 255, 0) 'Green Else 'الملف غير موجود Me.cmd_Open_the_File_from_Destination.BackColor = RGB(255, 0, 0) 'Red End If End Sub جعفر 584.1.Copy PDF from A folder To B Folder.accdb.zip

ما شاء الله بدون تعليق

الاخ ابو الحسن عندما عملت الملف لم الاحظ طلبك الثاتى لانى بفتح النت عند الفجر الاخ محمود الشريف شكرا على الملف ممتاز ونتمنى يكون المطلوب للاخ ابو الحسن

أخى فى الله الأستاذ // أبو الحسن الملف بالمرفقات بعد اتمام المطلوب ( كتابة أى رقم عربي وانجليزى أو حروف عربي وانجليزى أو الاثنين معا ) مرتبات تم التعديل.rar

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

كيف زر واحد؟ شو الاوامر اللي تريدها تصير ، بالتسلسل؟

تفضل Option Compare Database Private Sub cmd_Copy_From_Source_to_Destination_Click() Source = DLookup("[attachemnts bath]", "bath", "[ID] = 1") Destination = DLookup("[attachemnts bath]", "bath", "[ID] = 2") FileCopy Source & "\" & Me.ID & ".PDF", Destination & "\" & Me.ID & ".PDF" End Sub Private Sub cmd_Open_the_File_from_Destination_Click() Dim strFilePath As String Destination = DLookup("[attachemnts bath]", "bath", "[ID] = 2") strFilePath = Destination & "\" & Me.ID & ".PDF" If Dir(strFilePath) <> "" Then Application.FollowHyperlink strFilePath Else MsgBox "There are no GAS Certificates saved for this Property. Please Add or Scan a new document!" End If End Sub Private Sub Form_Load() Dim strFilePath As String Destination = DLookup("[attachemnts bath]", "bath", "[ID] = 2") strFilePath = Destination & "\" & Me.ID & ".PDF" If Dir(strFilePath) <> "" Then 'الملف موجود، غير لون خلفية الزر الى اخضر Me.cmd_Open_the_File_from_Destination.BackColor = RGB(0, 255, 0) 'Green Else 'الملف غير موجود Me.cmd_Open_the_File_from_Destination.BackColor = RGB(255, 0, 0) 'Red End If End Sub جعفر Copy PDF from A folder To B Folder.zip

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

اتفضل جرب ووافيني بالنتيجة انا استخدمت هذا الكود Dim nTikrar As Integer nTikrar = DCount("[رقم الموظف]", "حضور", _ "[رقم الموظف]=" & Me.ID & _ " And [التاريخ] = #" & Date1 & "#") If nTikrar > 0 Then MsgBox ("هذا الاسم مسجلة اليوم") Exit Sub Else Me.idh = Me.ID Me.timeh = Me.time1 Me.dateh = Me.Date1 Refresh DoCmd.GoToRecord , , acNewRec End If منع تكرار التسجيل.rar

السلام عليكم اختي 1. لا يوجد مرفق في مشاركتك الاخيرة ، 2. لتفريغ بيانات جدول اسمه table1 DELETE * FROM table1 واذا اردتي تشغيله في الكود docmd.setwarnings false docmd.runsql "DELETE * FROM table1" docmd.setwarnings true 3. لطباعة موظف واحد في التقرير ، انظري الرابط جعفر

السلام عليكم ورحمة الله جرب المرفق بعد تعديل طفيف جدا... بن علية فحص.rar

وعليكم السلام 1. نفترض الملف الحالي في \:C والمجلد الجديد الى \:E للنسخ FileCopy "Source Path And Name", "Destination Path And Name" FileCopy "C:\myfile.pdf", "E:\Temp\File_With_New_Name.pdf" لنقل الملف من مجلد الى آخر Name "old path AND name" As "new path AND name" Name "C:\myfile.pdf" As "E:\Temp\File_With_New_Name.pdf" 2 و 5 . عند طلب تشغيله: application.followhyperlink "E:\Temp\File_With_New_Name.pdf" 3 و 4 . If Dir("E:\Temp\File_With_New_Name.pdf") <> "" Then 'الملف موجود، غير لون خلفية حقل النص الى اخضر me.Field1.backcolor=rgb(0,255,0) 'Green Else MsgBox "الملف غير موجود" me.Field1.backcolor=rgb(255,0,0) 'Red End If جعفر

جرب الكود التالي (تم العمل على الملف الأصلي في المشاركة الأولى بعد فهم المطلوب) Sub Test() Dim rngCom As Range Dim cCom As Range Dim strCom As String Dim x As Variant Dim strDay As String Dim y As Variant Dim strDate As String Dim strDayNew As String Dim z As Variant Application.ScreenUpdating = False With ActiveSheet On Error Resume Next Set rngCom = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeComments) On Error GoTo 0 If rngCom Is Nothing Then MsgBox "No Comments Found", vbExclamation Exit Sub End If For Each cCom In rngCom strCom = cCom.Comment.Text x = Split(Application.WorksheetFunction.Trim(strCom), vbLf) strDay = x(1) y = Split(strDay) strDay = Trim(y(2)) strDate = x(2) z = Split(strDate) strDayNew = Application.Text(Replace(z(0), ".", "/"), "[$-409]dddd") If strDayNew <> strDay Then cCom.Comment.Text Replace(strCom, strDay, strDayNew) End If Next cCom End With Application.ScreenUpdating = True End Sub

أهلين أخي العزيز جعفر و الله شرفتنا بمشاركتك. 1- الشريط يفتح تلقائيا و بدون أي تدخل و ذلك لأنني قمت بإضافة وحدة نمطية تتحسس لفتح التقارير و عند وجود أي تقرير مفتوح سوف تقوم بفتح الشريط مباشرة. 2- قمت بإضافة نموذج frm1 و وضعت أمر فتحه في حدث عند التحميل للنموذج الرئيسي و يبقى هذا النموذج مفتوح لكنه مخفي 3- وضعت أمر فتح الوحدة النمطية في حدث عند عداد الوقت (TIMER) للنموذج frm1 و أعطيت قيمة الفاصل الزمني نصف ثانية يعني أنه كل نصف ثاني يتحقق البرنامج هل هناك تقرير مفتوح أم لا و على هذا الأساس يقوم بفتح شريط الطباعة. 4- أضف ما شئت من التقارير و ضع كود فتحها بشكل عادي فالوحدة النمطية سوف تتعرف تلقائيا على اسم النموذج المفتوح و الشريط سوف يتحكم بأوامر التقرير كليا. 5- و إذا شئت قم بفتح التقرير من شريط التنقل سوف ترى أن الشريط يفتح معه أيضا. يعني أنه لإضافة شريط الطباعة هذا لا تحتاج لأي تغيير على أوامرك السابقة. فقط قم بتصدير الوحدة النمطية و النموذج frm1 و شريط الطباعة إلى برنامجك و ضع كود فتح النموذج frm1 في وضعية الإخفاء في حدث عند التحميل للنموذج الرئيسي لديك. و هذا هو الملف بعد التعديلات الأخيرة إنشاء شريط طباعة.rar نعم أخي تستطيع ذلك. إذا كنت تريد طباعة عدد من الصفحات أضغط على الزر إعداد الطباعة و اختر الصفحات التي تريدها و عدد النسخ كما توضح الصورة التالية: و إذا كنت تريد عدد النسخ المطبوعة من الصفحة الحالية فقم بالتالي: 1 أضف مربع نص 2 قم بكتابة اسم مربع النص مكان 1 في هذا الكود لزر "ط ص الحالية": DoCmd.PrintOut acPages, Me.NPg, Me.NPg, acHigh, 1, False

السلام عليكم تفضل هو تقرير واحد ، وكل شئ معتمد على qry_Temp التي يكون فيها التواريخ كاملة ، والتقرير مصدره qry_T22 ، واستعملت الاستعلام المشروط ، حيث جعلت الايام التي ليس فيها غياب ولا تأخير ، باللون الاصفر: . جعفر 459.3.AbsentLate-10-12-2016.accdb.zip

غدا ان شاء الله (فنيا اليوم)

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

الاخ مودى تكبير حجم خط شريط الصيغة هل هذا المطلوب

السلام عليكم أستاذ علي معلش اتحملني شوي ، الطلب ليس متكامل اولا انا نسيت ايش بالضبط اللي لازم يصير (العتب على الشيب) ، ولكني عملت تغيير في الخطة ، وان شاء الله يكون مناسب للنوعين من التقارير اختر تاريخين من النموذج frm_PrintRpt ، للإختيار الاول "بين تاريخين محددين" . 1. لما تضغط على زر عمل التقرير ، البرنامج يعمل جدول خارجي ، به التواريخ والايام و eSIS جميع الطلبة للصف والشعبة ، هذا الجدول المؤقت (tmp_tbl_Dates_Days) في البرنامج المؤقت (tmp_Dates_Days.mdb) يتكون في مجلد الوندوز Temp ، ولست بحاجة لرؤيته ، وعندما يتكون الجدول ، ترى نتائجه في الاستعلام qry_Temp ، 2. تلقائيا الاستعلام qry_T2 يفتح ، وسترى فيه جميع الايام ، سواء بغياب او بدون ، ويجب ان نعدل الحقول في هذا الاستعلام ، ونعمل التقريرين منه رجاء فحص هذا العمل ، لأنه سيستبدل العمل السابق ، ولكني بحاجة الى توجيهك للخطوة التالية اما الاختيار الثاني "طباعة التقرير بالكامل" فيقوم الكود بأخذ اول يوم في الجدول ، وآخر يوم ، ويقوم بنفس العملية اعلاه الاستعلامات الوحيدة التي اعتمدت عليها في هذه الخطوة هي qry_T1 و qry_T2 و qry_Temp ، والشغل كله تقوم به الوحدة النمطية التالية: Option Compare Database Dim tbdf As TableDef, qrydf As QueryDef, fld As Field Dim rst As DAO.Recordset, rst_TQ As DAO.Recordset Dim sfrm As Form Dim wrkAcc As Workspace Dim dbsNew As Database Dim mdb_Name As String Public H1 As Integer Function Make_DB() On Error GoTo err_Make_DB 'populate Arabic day in an array Dim Arabic_Days() As String Set rst = CurrentDb.OpenRecordset("Select * From tbl_Months") rst.MoveLast: rst.MoveFirst ReDim Arabic_Days(7) For i = 1 To 7 Arabic_Days(i) = rst!Day_A rst.MoveNext Next i 'How Many Students mySQL = "SELECT Grade, Section, eSIS FROM tbl_Follow4" mySQL = mySQL & " Where Grade='" & [Forms]![frm_PrintRpt]![StuGrade] & "'" mySQL = mySQL & " AND Section='" & [Forms]![frm_PrintRpt]![StuSection] & "'" mySQL = mySQL & " GROUP BY Grade, Section, eSIS" 'Debug.Print mySQL Set rst_TQ = CurrentDb.OpenRecordset(mySQL) rst_TQ.MoveLast: rst_TQ.MoveFirst How_Many_Students = rst_TQ.RecordCount 'create an empty Dates_Days.mdb in the same folder as the FE 'this will allow more than one user to use This DB Set wrkAcc = CreateWorkspace("AccessWorkspace", "admin", "", dbUseJet) 'database name and path (in the Windows Temp Folder) mdb_Name = GetWinTemp & "\tmp_Dates_Days.mdb" 'mdb_Name = Application.CurrentProject.Path & "\tmp_Dates_Days.mdb" ' Make sure there isn't already a file with the name of the new database. If Dir(mdb_Name) <> "" Then Kill mdb_Name ' Create the new database Set dbsNew = wrkAcc.CreateDatabase(mdb_Name, dbLangGeneral) dbsNew.Close wrkAcc.Close 'make a Table tmp_tbl_Dates_Days using "Make Table" query in the DB Dates_Days.mdb mySQL = "SELECT tmp_tbl_Dates_Days.* INTO tmp_tbl_Dates_Days IN " & Chr(34) & mdb_Name & Chr(34) mySQL = mySQL & " FROM tmp_tbl_Dates_Days" 'Debug.Print mySQL DoCmd.SetWarnings False DoCmd.RunSQL mySQL DoCmd.SetWarnings True 'set the Dates required If Forms!frm_PrintRpt!MyDates = 1 Then fDate = Forms!frm_PrintRpt!FromDate tDate = Forms!frm_PrintRpt!ToDate Else fDate = DMin("[DayDate]", "tbl_Follow4") tDate = DMax("[DayDate]", "tbl_Follow4") End If Set dbsNew = OpenDatabase(mdb_Name) Set rst = dbsNew.OpenRecordset("Select * From tmp_tbl_Dates_Days") For j = 1 To How_Many_Students N = fDate dif = DateDiff("d", fDate, tDate) For i = 0 To dif N = DateAdd("d", i, fDate) 'MsgBox "Date:" & N & vbCrLf & "Day :" & Format(N, "dddd") 'skip Fridays and Saturdays If Weekday(N) <> 6 And Weekday(N) <> 7 Then rst.AddNew rst!DayDate = N rst!DayName = Arabic_Days(Weekday(N)) 'Format(N, "dddd") rst!eSIS = rst_TQ!eSIS rst.Update 'MsgBox Arabic_Days(Weekday(N)) & vbCrLf & Format(N, "dddd") End If Next i rst_TQ.MoveNext Next j 'now make the query qry_Temp based on the new location mySQL = "SELECT Auto_ID, DayDate, DayName, eSiS" mySQL = mySQL & " FROM tmp_tbl_Dates_Days IN " & Chr(34) & mdb_Name & Chr(34) mySQL = mySQL & " ORDER BY Auto_ID" 'delete the old qry_Temp DoCmd.DeleteObject acQuery, "qry_Temp" 'make the new qry_Temp Set qrydf = CurrentDb.CreateQueryDef("qry_Temp", mySQL) rst.Close: Set rst = Nothing rst_TQ.Close: Set rst_TQ = Nothing dbsNew.Close Exit Function err_Make_DB: If Err.Number = 3270 Then 'this field does not have a caption for it, give it the field name ElseIf Err.Number = 3024 Or Err.Number = 91 Or Err.Number = 52 Or Err.Number = 53 Or Err.Number = 3055 Then 'mdb, and Table not found to Delete Resume Next ElseIf Err.Number = 3167 Then 'ignor, Records Deleted Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Function جعفر 459.2.AbsentLate-10-12-2016.accdb.zip

ارفق الملف وان شاء الله نساعدك في الحل

تفضل وتدلل يا باشا . الكود Private Sub cmd_Add_Command_Button_and_Code_Click() Dim str As String, theForm As String Dim ctl As Control theForm = Me.form_list.Value DoCmd.OpenForm theForm, acDesign, , , , acHidden Set ctl = CreateControl(theForm, acCommandButton, acDetail, , , 1440, 2160, 2880, 600) ctl.Name = Me.Button_Name ctl.Caption = "للتجربة" str = "Private Sub " & Me.Button_Name & "_Click" & vbCrLf & _ DLookup("[CLine]", "tbl_secur_add_code", "[SN]=1") & vbCrLf & _ "End Sub" Forms(theForm).Module.AddFromString str DoCmd.Close acForm, Forms(theForm).Name, acSaveYes End Sub جعفر 472.اضافة كود فى محرر الاكواد بزر امر.mdb.zip

معلش ، العتب على النظر ، تفضل يا سيدي Private Sub Command1_Click() Dim str As String, theForm As String For i = 0 To Me.form_list.ListCount - 1 theForm = Me.form_list.ItemData(i) DoCmd.OpenForm theForm, acDesign, , , , acHidden str = "Private Sub Form_Open(Cancel As Integer)" & vbCrLf & _ DLookup("[CLine]", "tbl_secur_add_code", "[SN]=1") & vbCrLf & _ "End Sub" Forms(theForm).Module.AddFromString str DoCmd.Close acForm, Forms(theForm).Name, acSaveYes Next i End Sub جعفر

تفضل ولكن بكود آخر: Private Sub Command1_Click() Dim str As String, theForm As String theForm = Me.form_list.Value DoCmd.OpenForm theForm, acDesign, , , , acHidden str = "Private Sub Form_Open(Cancel As Integer)" & vbCrLf & _ DLookup("[CLine]", "tbl_secur_add_code", "[SN]=1") & vbCrLf & _ "End Sub" Forms(theForm).Module.AddFromString str DoCmd.Close acForm, Forms(theForm).Name, acSaveYes End Sub جعفر 472.اضافة كود فى محرر الاكواد بزر امر.mdb.zip

طريقة عمل شاشة ( فورم ) ادخال وترحيل واستعلام وتعديل !! خطوة خطوة السلام عليكم اساتذة المنتدي وخبراؤه الكبار الاخوة الافاضل المرفقات عدد ( 2 ) ملف فيديو يشرح طريقة التصميم واضافة الاكواد وكذلك مشاهدة النتيجة حيث لم اتمكن من اضافتهم في المشاركة الاولي نظرا للمساحة المخصصة لكل عضو ( حسب علمي ) فيديو2 .. طريقة عمل شاشة ادخال 2.rar شاهد النتيجة فيديو3 .. طريقة عمل شاشة ادخال 3.rar

السلام عليكم ورحمة الله وبركاته لى طلب ياريت تساعدونى فيه المرفق اللى موجود به تاريخ معين انا عايز اطرح التاريخ ده من تاريخ اليوم واخلى عدد السنوات لوحدها والشهور المتبقيه بعد احتساب السنوات والايام المتبيقيه بعد احتساب الشهور مثلا التاريخ هو 30/8/2010 اذن السنوات 1 والشهور 1 والايام 2 حيث ان تاريخ اليوم هو 28 / 7 / 2011 وانا جربت دالة datediff بس مشكلتها ان لو عندى تاريخ فى 30 / 12 / 2010 واليوم 28 / 7 / 2011 بيقرا على انها سنه وده غلط المفروض تكون 6 شهور و 28 يوم ياريت المساعده 1.rar