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

السلام عليكم شكرا اخوتي انس ورضوان (زين سمعنا صوتك) وشفان بدأ الموضوع بعدة اسأله عن امكانية التعامل مع مواقع الانترنت ، ومعظمها عن ارسال البيانات ، وخصوصا لموقع الشموس ، وعلمنا اخونا العود أبوخليل (اعرف انه متابع الموضوع) ، ان الاسئلة المتكررة يعمل لها موضوع مستقل فيه حل شامل ، فانا هنا احاول الاقتداء به بدأ المشروع بشئ صغير ، ولكن الفكرة توسعت ، لتسهل العمل على المبرمج ، وليكون البرنامج مكتبة لعمل العديد من الاشياء. وهذا جعلني اتأخر عن بعض زبائني ، والتأخر عن مساعدة العديد من الشباب في المنتدى عمل البرنامج (طبعا لن يشتغل البرنامج على جميع المواقع ، وبالتجربة فقط تستطيع معرفة عمله مع اي موقع) : النموذج frm_browse يحتوي على كائن Microsoft Web Browser ، ندخل اسم الموقع في حقل التحرير والسرد url_Address ، ثم نضغط على الزر Go ، والذي سيفتح الموقع في النموذج ، الزر "احفظ csv" سيقرأ كائنات الموقع ، ويحفظها في ملف بصيغة csv (اللي ينفتح بالاكسل) ، ثم يفتح الملف ، وفيه 3 طرق لإرسال معلومات الى اي حقل تريد (يعني يعطيك الكود جاهز لكل حقل) ، والافضل استعمال الكود الذي في العمود "Usage2" ، حيث ليست جميع الحقول لها اسماء (للأسف في بعض المواقع) ، الأفضل منه هو زر "احفظ في الجدول" ، حيث سيحفظ كائنات الموقع في جدول في البرنامج نفسه ، والاصعب كان حفظ بيانات حقول التحرير والسرد ، الزر "تجربة ارسال ، استيراد بيانات لهذا الموقع" يفتح النموذج frm_Send_Get وبه كائنات الموقع واسماء الحقول (حسب اسمها في البرنامج وليس حسب ظهورها على الموقع ، فالموضوعين غير مرتبطين للأسف في برمجة الموقع) ، هنا نستطيع تجربة اذا كان بإمكاننا ارسال/استرجاع بيانات الى/من الموقع ، فتختار اي حقل تريد التجربة عليه ، وتكتب المعلومة التي تريد ارسالها في الحقل Send_Data وبالنقر المزدوج على المعلومة ، وسترى انه تم ادخالها في الحقل في الموقع ، ويمكن التأكد كذلك من امكانية قراءة معلومة الحقل بالنقر المزدوج على الحقل Get_Data ، بالنسبة لحقول التحرير والسرد ، فالموضع يختلف قليلا ، لأنه مثل الاكسس ، فالمعلومة التي تراها في اختيار المعلومة من هذا الحقل ، ليس معناه انها نفس القيمة التي تُحفظ في الجدول ، لذلك يجب عليك النقر المزدوج على الحقل ref_Name ، فيعطيك قائمة الاختيار من النموذج frm_Options ، وبالنقر المزدوج على الحقل Opt_Value ستنتقل المعلومة الى الحقل في Send_Data النموذج frm_Send_Get ، والتي يمكن بالنقر المزدوج عليها ان ترسل المعلومة الى الحقل في الموقع (وهنا قد لا ترى التغير على الحقل في الموقع ، ولكن عندما تنقر عليه لتختار ، ستجد ان الاختيار قد تم حسب رغبتك) ، الى هنا وقلت اقفل الموضوع!! ولكن ، صحيح اني قدمت كود ارسال/استرجاع البيانات ، وبيانات حقول التحرير والسرد ، ولكن العملية متعبة في عمل جدول جديد ونموذج وكود لكل حقل ووو ، فرأيت ان اواصل العمل ، ولم اعرف مدى صعوبة عمل والتحكم بقاعدة بيانات خارجية ، فلهذا السبب اخذ وقت اكثر بكثير مما كنت اعتقد: فعملت الزر "عمل نموذج ارسال ، استيراد بيانات لهذا الموقع" ، والذي يفتح النموذج frm_Make_Form ، والزر السحري فيه هو "اعمل النموذج" ، والذي: يعمل قاعدة بيانات جديدة ، حسب اسم المسار واسم البرنامج الذي تريده ، ويعمل فيها 4 جداول تحتوي على معلومات الموقع وكائناته ، ثم يعمل النموذج الخاص بهذا الموقع ، وتكون الحقول جاهزة للإستعمال ، مع حقول التحرير والسرد ، ويكون هذا النموذج مربوطا بالجدول tbl_web_Send_Get ، النموذج به زر "Send Data" وزر "Retrieve Data" ، العمل المتبقي هو عمل الكود لهذه الازرار ، بحيث يكون النموذج جاهز 99% ، وتبقى الـ 1% للتعديلات التي قد لا اطالها. ارفق لكم البرنامج الى حيث وصلت (مع العديد من الاشياء التجريبية التي يجب حذفها في البرنامج النهائي) ، وان شاء الله لما اكمل الجزء المتبقي ، سارفقه كذلك (حينها سأقوم بتعديل الموضوع من اول وجديد ، ترتيب الصور مع الشرح والمرفق الاخير ، ان شاء الله). جعفر Pre-WebBrowser.zip

ان شاء الله خلاص مافي المشاكل بعد اي الان ان شاء الله نعم والان صار كود في الحال للنموذج الى Private Sub Form_Current() On Error GoTo HandleErr Dim rs As Object If Not IsNull([PicFile]) Then [imgPicture].Picture = [PicFile] SysCmd acSysCmdSetStatus, "Image: '" & [PicFile] & "'." Set rs = Me.Recordset.Clone rs.FindFirst "[Name_b] = '" & Me![مربع_تحرير_وسرد96] & "'" If Not rs.EOF Then Me.Bookmark = rs.Bookmark Else [imgPicture].Picture = "" SysCmd acSysCmdClearStatus End If Exit Sub HandleErr: If Err = 2220 Then [imgPicture].Picture = "" SysCmd acSysCmdSetStatus, "Can't open image: '" & [PicFile] & "'" Set rs = Me.Recordset.Clone rs.FindFirst "[Name_b] = '" & Me![مربع_تحرير_وسرد96] & "'" If Not rs.EOF Then Me.Bookmark = rs.Bookmark Else MsgBox Err.Description, vbExclamation End If End Sub واليك ملفك بعد تعديل test50.rar

تفضل تنبيه في حالة ادخال ارقام اقل واكبر.rar

وعليكم السلام تفضل تنبيه في حالة ادخال ارقام اقل واكبر1.rar

وعليكم السلام Sub CreatePDFFilesForSpecificSheets() Dim ws As Worksheet Dim Fname As String Application.ScreenUpdating = False For Each ws In Sheets(Array("Sheet1", "Sheet2", "Sheet4", "Sheet6")) On Error Resume Next Fname = ThisWorkbook.Path & "\" & ws.Range("A1").Value & " " & Replace(ws.Range("A2").Value, "/", "_") & ".pdf" ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fname, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False Next ws Application.ScreenUpdating = True MsgBox "Done...", 64 End Sub

ما هو سبب ارتجاف واهتزاز عناصر التحكم في النموذج عند تحريك الماوس في النموذج لبعض قواعد البيانات وخاصة عند استخدام سمات او اسطح الويندوز XP ؟ قد يكون الحل يدويا على مستوى حقل او حقلين لايوجد به مشكلة ولكن هل من المعقول نقوم بحل هذه المشكلة يدويا لعدد 30 او اربعين مربع نص او عنصر تحكم على النموذج اذن يكون الحل برمجيا . اولا لنعرف السبب . ان الارتجاف او الاهتزاز هو ناتج عن فقد اقتران مربع التسمية بمربع النص التابع له لهذا يحدث ما يسمى بالـ Flicker with tab controls وتحدث هذه المشكلة عند حذف مربع التسمية الاصلي لمربع النص واستبداله بآخر غير مقترن او وضع زخرفات زائدة لمربع التسمية . ولحل هذه المشكلة لديك عدة خيارات : 1. اما ان تجعل سمات الويندوز على وضع كلاسيكي وهذا حل غير عملي لانه سيستخدم هذه القاعدة غيرك لديهم سمات ويندوز XP نشطه . 2.. في حالة فقدان اقتران مربع التسمية بمربع النص الخاص به تظهر في الركن العلوي الايمن علامة مثلث اخضر وعليه تنبيه لو قمت بتقريب الماوس الى هذا المثلث والضغط بالماوس الايمن عليه ستظهر لك قائمة منبثقة ( النموذج في حالة وضع التصميم ) ومن ضمن خياراتها اقتران مربع التسمية بمربع النص التاابع له وستحل المشكلة يدوبا . 3. والحل الاخير هو برمجيا لهذا نتبع هذه الطريقة : 1. قم بإنشاء وحدة نمطية جديده . 2. قم بنسخ هذا الكود للوحدة النمطية ومن ثم قم بحفظها . Function ConvertLabelOnTabPage(strFormName As String, _ Optional bSaveAndClose As Boolean, Optional bHidden As Boolean) 'الغرض : تغيير التسميات الغير مرتبطة بمربعات النص في النموذج 'لاصلاح مشكلة الاهتزاز في سمات الويندوز اكس بي Dim frm As Form Dim ctl As Control Dim strName As String Dim strCaption As String Dim bytBackStyle As Byte Dim bChanged As Boolean Const strcQuote = """" 'افتح النموذج في وضع التصميم DoCmd.OpenForm strFormName, acDesign, _ windowmode:=IIf(bHidden, acHidden, acWindowNormal) Set frm = Forms(strFormName) 'البحث عن مربعات التسميات العائدة لمربعات النص 'Find the labels whose parent is a tab page. For Each ctl In frm.Controls If ctl.ControlType = acLabel Then If ParentIsTabPage(ctl) Then bChanged = True strName = ctl.Name 'اسم مربع النص الذي فقد التسمية strCaption = ctl.Caption 'تسمية مربع النص bytBackStyle = ctl.BackStyle 'برنامج الاكسيس لا يمكنه عمل هذا Debug.Print strFormName & "." & strName 'Convert it to a text box. ctl.ControlType = acTextBox 'Set the text box properties. With frm.Controls(strName) 'اسماء مربعات النص لغير محدد .ControlSource = "=" & strcQuote & _ Replace(strCaption, strcQuote, strcQuote & strcQuote) & strcQuote .Enabled = False .Locked = True .BackStyle = bytBackStyle End With End If End If Next Set ctl = Nothing Set frm = Nothing If Not bChanged Then DoCmd.Close acForm, strFormName, acSaveNo ElseIf bSaveAndClose Then DoCmd.Close acForm, strFormName, acSaveYes End If End Function Private Function ParentIsTabPage(ctl As Control) As Boolean On Error Resume Next ParentIsTabPage = (ctl.Parent.ControlType = acPage) End Function Function FixAllForms() 'الغرض : تشغيل تحويل مربعات التسميات جميعها في قاعدة البيانات 'تحذير : قم بحفظ قاعدة البيانات قبل عمل هذا الاجراء Dim accobj As AccessObject For Each accobj In CurrentProject.AllForms Call ConvertLabelOnTabPage(accobj.Name, True, True) Next End Function 3. لاجراء اختبار وانت داخل الوحدة النمطية من نافذة Immediate التي تستطيع الوصول لها بضغط المفاتيح Ctrl+G من لوحة المفاتيح وكنابة هذا الامر ? ConvertLabelOnTabPage("MyForm") MyForm اسم النموذج الخاص بك ثم اضغط Enter 4. ستظهر لك في النافذة السفلية جميع مربعات التسميات التي تم تحويلها وارتباطها بمربعات النص . 5. لاصلاح جميع مربعات التسميات في جميع النماذج في قاعدة البيانات استخدم هذا الامر بدلا عن السابق ? FixAllForms() ملاحظة : يجب اخذ نسخة احتياطية لقاعدة بياناتك قبل هذه العملية 6. لاصلاح مجموعة الخيار option groups لمربعات النص استبدل هذا الكود في دالة () ParentIsTabPage Private Function ParentIsTabPage(ctl As Control) As Boolean On Error Resume Next ParentIsTabPage = ((ctl.Parent.ControlType = acPage) Or _ (ctl.Parent.ControlType = acOptionGroup)) End Function

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

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

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

أخى الكريم هل إطلعت على المرفق الذى أرفقته ؟ لو شاهدته كنت هتعرف انى فى آخر عمود بصفحة الإدخال موضح هذه الجملة

مرحبا جرب المحاولة التالية test_1.rar

أخى الكريم بارك الله فيك شرح مبسط ورائع لكيفية استخدام الدالة Indirect وربط عدة قوائم منسدلة بالتوفيق إن شاء الله وفى انتظار شرحات فيديو أخرى لإثراء الموضوعات

ربنا ميحرمنيش منّك....................... ويجزيك كل الخير تسلم يا أستاذي الكريم

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

جرب الملف المرفق بيان بمعلمى المدرسة Salim.rar

تفضل بيان بمعلمى المدرسة وتخصصاتهم.rar

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

السادة الافاضل اخوتى فى هذا الموقع اعمل بالتربية والتعليم منذ عام 1972 وبعد خروجى من الجيش عام 1975 ومن عام 1980 وانا اعمل بكنترول اى مدرسة اعمل بها وخرجت الى المعاش عام 2008 ومن هذا التاريخ وانا اعمل بكنترول مدرسة خاصة كبيرة جدا تحتوى على جميع المراحل التعليمية ووجدت انه من الافضل ان تكون لمدرستى شيتات خاصة بها وفقا لمتطلبات العمل بها وساعدنى ان اعمل شيتات لمدرستى المامى بالفيجول بيزيك ووصلت فيه لمرحلة لا بأس بها ولايقتصر عملى على شيتات نتيجة وشهادات فقط ولكن طورت ذلك الى شيت اخر به كيفية عمل قوائم الفصول وبمساعدة من موقعكم من مشاركة من احد الاخوة ثم طورت الشيت وجعلته يطبع كشوف اعمال السنة للمدرسين مكتوبة بالاسماء مما يوفر الجهد للمدرسين ويوحد شيتات اعمال السنة مما يساعد على الرصد بكشف النتيجة ثم اضفت للشيت كشوف المناداه للجان والملصقات مثل اغلفة الاسئلة واغلفة الاجابة وبيان اللجان جاهزة بالبيانات وكذلك كشوف الملاحظة تطبع بارقام الجلوس بها لتسهيل العمل وكذلك كشوف الانشطة تطبع جاهزة بالاسماء وغيره من احتياج المدرسة وكل ذلك بالاتصال مع الشيت الاصلى ووضعت بالمنتدى العمل ولكن لم اجد مشاركات وربما انا اخترت وقت غير مناست فهل هنا مطلوب الاعمال من البداية اما اعمال جاهزة وانا اعلم ان بالموقع عمالقة ويسعدنى ان اشارك معكم لاعطى واستفيد لتطوير عملى فانا عندى شيتاتى بها مجهود واعتمدت على معلومات احصل عليها من موقعكم العظيم ولكن بالمشاركة سوف اطور عملى فأنا منتظر ردكم هل المطلوب الاعمال من البداية ؟؟ فأنا استطيع ان اشارك معكم افيد بخبرتى المتواضعة واستفيد من خبراتكم الكبيرة

الدرس السادس: الدوال النصية هنالك الكثير من الدوال المستعملة في VBA و سوف نحاول ذكر الدوال المشهورة منها حسب عملها: Asc: إرجاع عدد صحيح يمثل رمز الحرف الأول في السلسلة النصية. مثال: Me.y = Asc("أوفيسنا") النتيجة=195 Chr: تحويل عدد صحيح إلى حرف أو رمز. مثال: Me.y = Chr("210") النتيجة=ز InStr: استخراج موضع بداية سلسلة ضمن سلسلة أخرى. مثال: Instr(المقارنة,السلسلةالمبحوث عنها,السلسلة التي يتم فيها البحث,مكان بداية البحث) Me.y = InStr(1,"homsalah", "a")=5 InStrRev: إرجاع موضع تواجد سلسلة ضمن سلسلة أخرى بدءا من نهاية السلسلة. InStrRev(المقارنة,بداية البحث,السلسلة المبحوث عنها,السلسلة) Me.y = InStrRev("homsalah", "a", -1)=7 LCase: تحويل حروف سلسلة إلى حروف صغيرة. مثال: Me.y = LCase("ABC")=abc UCase: تحويل الأحرف إلى أحرف كبيرة. مثال: UCase(السلسلة النصية) Me.y = UCase("abcd")="ABCD" Left: ارجاع جزء من سلسلة حرفية حسب عدد الحروف المطلوبة من جهة اليسار. مثال: Left(عدد الأحرف المطلوبة,السلسلة ) Me.y = Left("1999", 2)=19 Len: حساب عدد الأحرف في السلسلة. مثال: len(السلسلة) Me.y = Len("1999")=4 LTrim: حذف الفراغات الموجودة في الجهة اليسرى. مثال: Trim(السلسلة) Me.y = Trim(" 1999")="1999" Mid: ارجاع جزء من سلسلة بحيث تحدد بداية الجزء و طوله (عدد الأحرف). مثال: Mid(عدد الأحرف,نقطة البداية(رقم),السلسلة) Me.y = Mid("SALAH", 3, 2)="LA" Replace: تعويض جزء من سلسلة بجزء آخر. مثال: Replace(الجزء المعوض,الجزء الذي نريد استبداله,السلسلة) Me.y = Replace("SALAH", "H", "T")="SALAT" Right: ارجاع جزء من سلسلة حرفية حسب عدد الحروف المطلوبة من جهة اليمين. مثال: Right(عدد الحروف,السلسلة) Me.y = Right("SALAH", 2)="AH" RTrim: حذف الفراغات الموجودة في الجهة اليمنى لسلسلة. مثال: RTrim(السلسلة) Me.y = RTrim("15 ")="15" Trim: حذف المسافات البادئة و الزائدة من سلسلة. مثال: Trim(السلسلة) Me.y = Trim(" 15 ")="15" Space: ارجاع سلسلة تتألف من عدد من المسافات المحددة. مثال: Space(عدد الفراغات) Me.y = Space(3)=" " Str: ارجاع متغير من نوع string يمثل رقم.(تحويل متغير من نوع رقم إلى متغير من نوع سلسلة نصية) مثال: Str(العدد) Me.y = Str(3)=" 3" Me.y = Str(-3)="-3" تقوم بإرجاع مسافة قبل الأعداد الموجبة StrComp: ارجاع عدد صحيح يشير إلى نتيجة مقارنة سلسلتين.إذا كانت متساوية يرجع 0 و إذا كانت مختلفة يرجع 1 أو 1- مثال: StrComp(السلسلة2,السلسلة1,المقارنة) Me.y = StrComp("ass", "ass")=0 Me.y = StrComp("as", "ass")=-1 StrConv: ارجاع سلسلة تم تحويلها كما هو محدد. مثال: StrConv(رقم يمثل رمز التحويل,السلسلة,LCID) Me.y = StrConv("ass", 1)="ASS" رموز التحويل: 1: يحول السلسلة إلى أحرف كبيرة 2: يحول السلسلة إلى أحرف صغيرة 3: يحول الحرف الأول من كل كلمة في السلسلة إلى حرف كبير 64: تحول السلسلة إلى Unicode باستخدام مخطط الشفرة الافتراضي للنظام. 128: تحول السلسلة إلى Unicode باستخدام مخطط الشفرة الافتراضي للنظام. و هذا الرابط به مختلف الرموز: https://support.office.com/ar-SA/article/الدالة-StrConv-19c3816f-dbc9-4adf-891c-fd32734c92e0 String: تكرار أحرف بعدد معين. مثال: String(الحرف, عدد التكرارات) Me.y = String(3, "S")="SSS" StrReverse: قلب ترتيب أحرف سلسلة نصية. مثال: StrReverse(السلسلة) Me.y = StrReverse("ABCD")="DCBA"

وعليكم السلام واهلا وسهلا بك في المنتدى الموضوع مخالف ، لذا رجاء كتابة موضوع جديد بعنوان واضح حسب المادة 3 ادناه قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف يُغلق - مُخالف. جعفر

أخى الكريم إطلع على الملف المرفق حركة الدواء_11.rar

جرب قراءة هذه الموضوعات وهذا وهذا وغيرها كثير بالمنتدى لو بحثت

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

اذا اردت فتح تقرير مع اغلاق كل النماذج المفتوحة بقاعدة البيانات واعادة فتح هذه النماذج بعد اغلاق التقرير قم بوضع هاتين الدالتين بوحدة نمطية عامة : الدالة الأولى : Public Function CloseForms() Dim objname As String Dim obj As AccessObject, dbs As Object Set dbs = Application.CurrentProject For Each obj In dbs.AllForms If obj.IsLoaded = True Then Dim db As DAO.Database Dim rst As DAO.Recordset Dim tbltest As DAO.TableDef Dim fldtest As DAO.Field Set db = CurrentDb Set tbltest = db.CreateTableDef("tblname") Set fldtest = tbltest.CreateField("formname", dbText) fldtest.Size = 50 tbltest.Fields.Append fldtest db.TableDefs.Append tbltest Set rst = db.OpenRecordset("tblname") While Forms.Count > 0 rst.AddNew objname = obj.Properties.Application.CurrentObjectName rst!formname = objname rst.Update obj.Properties.Application.DoCmd.Close Wend rst.Close db.Close End If Next obj End Function الدالة الثانية : Public Function OpenForms() Dim db As DAO.Database Dim rst As DAO.Recordset Set db = CurrentDb Set rst = db.OpenRecordset("tblname") rst.MoveFirst Do Until rst.EOF DoCmd.OpenForm rst!formname rst.MoveNext Loop rst.Close db.Close DoCmd.DeleteObject acTable, "tblname" End Function وقم باستداعاء الدالة الأولى عند حدث الفتح للتقرير الذي تريد لكي تقوم باغلاق جميع النماذج المفتوحه وحفظ اسماء هذه النماذج بجدول مؤقت . وقم باستدعاء الدالة الثانية عند حدث اغلاق نفس التقرير لكي تقوم بفتح النماذج التي كانت مفتوحة قبل فتح التقرير. مع خالص التحية :d