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

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

تفضل 123.xlsm

السلام عليكم و رحمة الله و بركاته أخي العزيز أبا جودي : اولا اشكرك على ما تقدمه لاخوانك في المنتدى ثانيا بعد اطلاع على البرنامج وجدت البرنامج يعمل بكفائة و ماشاء الله عليك و في نفس وقت حبيت عرض اقتراح اختصار وحدة نمطية modConverter من: Public Function ToUniCode(myData As String) myData = Replace(myData, ChrW(1569), "ChrW(1569)") myData = Replace(myData, ChrW(1570), "ChrW(1570)") myData = Replace(myData, ChrW(1571), "ChrW(1571)") myData = Replace(myData, ChrW(1572), "ChrW(1572)") myData = Replace(myData, ChrW(1573), "ChrW(1573)") myData = Replace(myData, ChrW(1574), "ChrW(1574)") myData = Replace(myData, ChrW(1575), "ChrW(1575)") myData = Replace(myData, ChrW(1576), "ChrW(1576)") myData = Replace(myData, ChrW(1577), "ChrW(1577)") myData = Replace(myData, ChrW(1578), "ChrW(1578)") myData = Replace(myData, ChrW(1579), "ChrW(1579)") myData = Replace(myData, ChrW(1580), "ChrW(1580)") myData = Replace(myData, ChrW(1581), "ChrW(1581)") myData = Replace(myData, ChrW(1582), "ChrW(1582)") myData = Replace(myData, ChrW(1583), "ChrW(1583)") myData = Replace(myData, ChrW(1584), "ChrW(1584)") myData = Replace(myData, ChrW(1585), "ChrW(1585)") myData = Replace(myData, ChrW(1586), "ChrW(1586)") myData = Replace(myData, ChrW(1587), "ChrW(1587)") myData = Replace(myData, ChrW(1588), "ChrW(1588)") myData = Replace(myData, ChrW(1589), "ChrW(1589)") myData = Replace(myData, ChrW(1590), "ChrW(1590)") myData = Replace(myData, ChrW(1591), "ChrW(1591)") myData = Replace(myData, ChrW(1592), "ChrW(1592)") myData = Replace(myData, ChrW(1593), "ChrW(1593)") myData = Replace(myData, ChrW(1594), "ChrW(1594)") myData = Replace(myData, ChrW(1600), "ChrW(1600)") myData = Replace(myData, ChrW(1601), "ChrW(1601)") myData = Replace(myData, ChrW(1602), "ChrW(1602)") myData = Replace(myData, ChrW(1603), "ChrW(1603)") myData = Replace(myData, ChrW(1604), "ChrW(1604)") myData = Replace(myData, ChrW(1605), "ChrW(1605)") myData = Replace(myData, ChrW(1606), "ChrW(1606)") myData = Replace(myData, ChrW(1607), "ChrW(1607)") myData = Replace(myData, ChrW(1608), "ChrW(1608)") myData = Replace(myData, ChrW(1609), "ChrW(1609)") myData = Replace(myData, ChrW(1610), "ChrW(1610)") myData = Replace(myData, ChrW(32), "ChrW(32)") ToUniCode = Replace(myData, ")ChrW", ") & ChrW") End Function Public Function ToArabic(myData As String) myData = Replace(myData, "ChrW(1569)", ChrW(1569)) myData = Replace(myData, "ChrW(1570)", ChrW(1570)) myData = Replace(myData, "ChrW(1571)", ChrW(1571)) myData = Replace(myData, "ChrW(1572)", ChrW(1572)) myData = Replace(myData, "ChrW(1573)", ChrW(1573)) myData = Replace(myData, "ChrW(1574)", ChrW(1574)) myData = Replace(myData, "ChrW(1575)", ChrW(1575)) myData = Replace(myData, "ChrW(1576)", ChrW(1576)) myData = Replace(myData, "ChrW(1577)", ChrW(1577)) myData = Replace(myData, "ChrW(1578)", ChrW(1578)) myData = Replace(myData, "ChrW(1579)", ChrW(1579)) myData = Replace(myData, "ChrW(1580)", ChrW(1580)) myData = Replace(myData, "ChrW(1581)", ChrW(1581)) myData = Replace(myData, "ChrW(1582)", ChrW(1582)) myData = Replace(myData, "ChrW(1583)", ChrW(1583)) myData = Replace(myData, "ChrW(1584)", ChrW(1584)) myData = Replace(myData, "ChrW(1585)", ChrW(1585)) myData = Replace(myData, "ChrW(1586)", ChrW(1586)) myData = Replace(myData, "ChrW(1587)", ChrW(1587)) myData = Replace(myData, "ChrW(1588)", ChrW(1588)) myData = Replace(myData, "ChrW(1589)", ChrW(1589)) myData = Replace(myData, "ChrW(1590)", ChrW(1590)) myData = Replace(myData, "ChrW(1591)", ChrW(1591)) myData = Replace(myData, "ChrW(1592)", ChrW(1592)) myData = Replace(myData, "ChrW(1593)", ChrW(1593)) myData = Replace(myData, "ChrW(1594)", ChrW(1594)) myData = Replace(myData, "ChrW(1600)", ChrW(1600)) myData = Replace(myData, "ChrW(1601)", ChrW(1601)) myData = Replace(myData, "ChrW(1602)", ChrW(1602)) myData = Replace(myData, "ChrW(1603)", ChrW(1603)) myData = Replace(myData, "ChrW(1604)", ChrW(1604)) myData = Replace(myData, "ChrW(1605)", ChrW(1605)) myData = Replace(myData, "ChrW(1606)", ChrW(1606)) myData = Replace(myData, "ChrW(1607)", ChrW(1607)) myData = Replace(myData, "ChrW(1608)", ChrW(1608)) myData = Replace(myData, "ChrW(1609)", ChrW(1609)) myData = Replace(myData, "ChrW(1610)", ChrW(1610)) myData = Replace(myData, "ChrW(32)", ChrW(32)) ToArabic = myData 'ToArabic = Replace(myData, ") & ChrW", ")ChrW") End Function اي تعديل فنكشن ToUnicode و حذف فنكشن ToArabic نهائي : Public Function ToUniCode(myData As String) Dim dgt As String Dim Newstring As String Dim i For i = 1 To Len(myData) dgt = AscW(Mid(myData, (i), 1)) Newstring = Newstring & " Chrw (" & Chr(34) & dgt & Chr(34) & ") & " Next i Newstring = Left(Newstring, (Len(Newstring) - 2)) ToUniCode = Newstring End Function و تغير في الكود الزر BtnToArabic كبديل فنكشن ToArabic الي: On Error GoTo Err_Handler Me.frmToArabic!txtArabic.ControlSource = "=" & Me.frmToArabic!txtUnicode Exit_Handler: Exit Sub Err_Handler: MsgBox Err.Description Resume Exit_Handler و اخيرا اتمنى لك صحة وتوفيق

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

حل مشكلة اختفاء ورقة الخصائص الشرح الاتى نقلا عن الاستاذ الفاضل معلمى الاستاذ @Shivan Rekany اتيت اليكم بالشرح نقلا عنه لمن يريده تفصيلا ولكن هدانى الله الى ان اضع الاوامر على زر امر مباشرة لسهولة التعامل واختصارا لكل تلك الخطوات واهديكم هذه الثاعدة التى تخص حل تلك المشكلة للعلم لن استطيع فى الوقت الحالى التجربة على اكثر من نسخة مختلفة لذلك لغفروا لى ان كانت فكرتى المتواضعة تعجز عن خل المشكلة مباشرة عند اختلاف النسخ property sheet visible or not.mdb

السلام عليكم ورحمة الله تعالى وبركاته احبائى اقدم لكم هذه الاداة البسيطة ذات الفائدة الكبيرة احيانا تحدث مشكلة عند تشغيل قاعدة بياناتك على بعض الأجهزة وذلك بسبب كتابة الحروف العربية داخل محرر الاكواد اثناء التصميم حتى وإن كانت ملاحظات وتلميحات وتم تعطيلها وبين طيات نقاش طويل بينى وبين استاذى الجليل ومعلمى القدير ووالدى الحبيب الاستاذ @jjafferr نصحنى وشدد على بــــ عدم كتابة اى احرف عربية داخل المحرر حتى وان كانت ملاحظات او تلميحات فسألته : وماذا ان اردنا كتابة رسالة باللغة العربية فأجابنى : بعمل جدول ليتم كتابة ما تريد باللغة العربية وتستدعيه وقت الحاجة فكرت وحاولت وبفضل الله تعالى ثم مساندة أستاذى الجليل فيما تعثرت فيه وتوصلت الى ذلك ولكن هناك شقين 1- الموضوع مرهق قليلا ويتطلب وقت وجهد كبيرين 2- بالرغم من النقطة السابقة الا انه ممتع جدا جدا جدا وبرغم صعوبته اثناء التصميم الا انه يعطى مرونه فى تغيير الرسائل بدون الرجوع الى محرر الاكواد وطبعا قد لا يستطيع البعض تحقيق ذلك لذلك فكرت فى بديل وكانت بفضل الله تلك الاداة البسيطة التى اضعها الان بين اياديكم شرح الاداة نكتب ما نريد فى المكان المخصص للغة العربية ونقوم بتحويل ما كتبناه الى الترميز العالمى نقوم بعمل نسخ الترميز العالمى الى محرر الاكواد داخل قاعدتك فى المكان المحدد لذلك من واقع الصورة الجزء الأيمن 1 >>---> المكان المخصص لكتابة اللغة العربية 2 >>---> زر الامر الذى يقوم بتحويل ما تم كتابتة الى الترميز العالمى Unicode 3 >>---> زر الامر الذى يقوم بنسخ الاحرف التى تم تحويلها الى الترميز العالمي الجزء الأيسر A >>---> لصق الترميز العالمى الذى قمت بنسخه من اى قاعدة بيانات تم استخدام هذا الترميز فيها من قبل B >>---> زر الامر الذى يقوم بتحويل الترميز العالمى Unicode الى اللغة العربية لتستطيع قراته مرفق لكم الاداة + قاعدة تجربة انتظر تجربتكم وافادتكم تم تعديل المرفق فى تمام الساعة 7:44 م بتوقيت القاهرة - تاريخ 23/09/2019 Converter Arabic and Unicode.zip Converter Arabic and Unicode.mdb

معلش استاذنا استحملنى خبرتى قليلة فى الاكسيل

استاذي الفاضل الف الف شكرا لك , هذا ما اريد واكثر الله يبارك فيك ويسعدك ويوفقك الف الف شكرا

عملتها استاذنا مشكلة صغيرة الكلام بيطلع انجليزى وليس عربى

جرب هذا الماكرو الاسم المطلوب في الخلية A1 تم تغيير اسماء الشيتات الى source_sh و target_sh لحسن عملية نسخ الكود ونقله بحيث لا تظهر حروف غريبة Sub Find_Recorde() Rem Created By Salim Hasbaya On 24/9/2019 Dim S As Worksheet: Set S = Sheets("source_sh") Dim T As Worksheet: Set T = Sheets("target_sh") Dim Nam: Nam = T.Cells(1, 1) Dim My_RG As Range Dim Saerch_Rg As Range T.Cells(3, 1).CurrentRegion.Clear Dim col%, Ro%, Actual_ro% Set Saerch_Rg = S.Columns(5).Find(Nam, lookat:=1) If Saerch_Rg Is Nothing Then MsgBox _ "This Name Dos not exit or Wrong Name" Exit Sub End If Ro = Saerch_Rg.Row + 1 col = S.Cells(Ro, Columns.Count).End(1).Column Actual_ro = S.Cells(Ro, 1).End(4).Row - Ro + 1 With T.Cells(3, 1).Resize(Actual_ro, col) .Value = S.Cells(Ro, 1).Resize(Actual_ro, col).Value .Borders.LineStyle = 1 .NumberFormat = "[$-,10A] ddd d mmm yyyy" .Interior.ColorIndex = 24 .Font.Bold = True End With End Sub الملف مرفق Record.xlsm

نعم اخي تفضل M_L - Copy.mdb

وعليكم السلام اخى الكريم بالطبع هذا امر طبيعى ومنطقى وليس له حل لأن عرض الصفحة المراد طباعتها اكبر من المعتاد عند الطباعة الأفقية واذا كنت حابب ان الكتابة تكون اكبر من ذلك فعليك بالتخلى عن ان تكون الطباعة على ورقة واحدة فبالتالى تكون على اكثر من ورقة وفى حالتك قد تكون على 6 ورقات مثلاٌ لكى يظهر حجم الكتابة طبيعية

بعد اذن اخي علي قائمة منسدله 1.xls

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

تفضل قائمة 1منسدله.xls

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

بعد ادن الاساتدة الكرام اليك التجربة لعلها ما تريد ضع مجلد باسم factur في سطع المكتب تم نفد حفظ بي دي اف.xlsm

اخي الكريم هناك اختلاف بين بعض رؤوس الجدول في الشيت و label في الفورم المهم تم تعديل كود البحث كما طلبت اظهار قيمة خلية في الفورم2 (1) (1).xlsm

من فضلك اخى الكريم لا تقوم بإهدار وقت الأساتذة فليس لأى عضو الحق فى رفع مشاركة الا بعد استخدام خاصية البحث فى المنتدى والتأكد ان ما يطلبه غير موجود من قبل فطلبك تم مناقشته فى موضوعات عديدة منها : https://www.officena.net/ib/topic/61101-حفظ-ورقة-العمل-بصيغة-pdf/

فورم اظهار البيانات المسجلة بالليست بوكس والبحث عنها فيديو 8 الفيديو

السلام عليكم بهذا الشكل Public X Sub Macro2() X = "Release" End Sub بالامكان ارجاع قيمة المتغير الى قيمة فارغة عند اغلاق المصنف وعند النقر على الزر يحط قيمتة Release وهكذا بحدث الصفحة Private Sub Worksheet_SelectionChange(ByVal Target As Range) If ActiveCell.Column = 4 And ActiveCell.Row > 5 Then If Not X = Empty Then MsgBox "الكود يعمل بطريقة صحيحة" End If End If End Sub

اخي @abood2626 اذهب إلى ورقة خصائص النموذج ثم إلى علامة التبويب الأخرى وقم بتغيير الخيار المنبثق إلى لا أوالعكس حسب ذوقك

وعليك السلام ورحمة الله وبركاته تفضل المطلوب اظهار قيمة خلية في الفورم2 (1).xls

بارك الله فيك وفي الاستاذ عصام الذي منحني وقت طويل واشكرك على التوضيح نعم قمت بالخطوات ولم اجرب شي، نبهتني عليه وهو بتحربه العرض ٣.٧٠ وقد قرات لمشاركه لواحد من الاخوان في منتدي قال انا العرض كان سبب المشكله عنده وهذا ما فراته وانت اكدته لي مشكور اليك استاذنا الغالي صالح وغدا اجربه باذن الله ولك اجمل تحيه وللاستاذ عصام شاكرين مقدرين جهدكم تحياتي

لاحظت انك واضع سعر الطن في (تسمية) يفضل ان تضعه في (مربع نص) لكي تتم العمليات الحسابية بشكل افضل اتوقع هنا مشكلتك جرب

السلام عليكم ورحمة الله وبركاته مساء الخير أحبتي رواج مملكة الأكسس والوورد أعتذر عن انقطاعاتي الكثيرة وماذاك الا الانشغال مع جدتي شفاها الله وعافها ولا أراكم مكروها اليوم كُنت في محل نظارات وهو محل تابع لمؤسسة معروفة لها أكثر من فرع لاحظتهم يستخدمون برنامج في كل فروعهم فأردت أُشبِع فُضولي حيث سألت مدير الفرع عن البرنامج الذي يستخدموه فقال لي أنه برنامج مُصمم بالأكسيس فاستأذنته بالاطلاع للتأكد وفعلاً وجدته ملف أكسيس ولكن من صممه أبدع كثيراً في تصميمه حتى أني لم أتوقع حينها أنه بالأكسيس , الذي صَدمني أكثر هو أنه تم شراء البرنامج بقيمة 500 ألف ريال على حد قول مدير الفرع ولم أصدقه مبدأياً حتى استرسل وفٌصل في الموضوع إذ تم شراء نسخة لكل فرع ومازلت حقوق البرنامج للمُبرمج ولم تُعطى للمؤسسة !! الموضوع بِرمته رسالة لمن يستهين بالأكسيس : ) لكم وافر التقدير والاحترام ومساءكم سعادة ,, الموضوع منقول من منتدي مملكة الاكسس والورد

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

ان ما اشتغل هذه المره يكون المشكله عندك انت Converter Arabic and Unicode.mdb

السلام عليكم تقريب آخر في الملف المرفق... بن علية حاجي شيت.xls

جرب هذا الملف Times_sh.xls

تم تعديل المرفق فى المشاركة الاصلية فى تمام الساعة 7:44 م بتوقيت القاهرة - تاريخ 23/09/2019 انتظر افادتكم ان شاء الله بعد نجاح التجربة معكم

تحية إجلال للمعلم الجليل المهندس سيد بدران صاحب قناة سيد بدران المشهورة .

أخى نسيم الروح الروح من فضلك إذا كانت الإجابة صحيحة أشر بتمت الإجابه

. New Microsoft Excel Worksheet1.xlsx

السلام عليكم ورحمة الله وبركاته جمعت كل اوراقي القديمة ومشاريعي وجعلتها في برنامج اسميته محاسبة 71 كل معرفتي بالاكسيس حاولت ان اضعها فيه نتمتى من الاخوة ابداء الراي برنامج محاسبة ومستودعات.rar

الرجال خاف من حكاية الدفع . هههههههه

لطلب التصميم اضغط الرقم 1 للعودة للقائمة الرئيسية اضغط الرقم 0 للتحدث لمسئولى الدعم الفنى والتطوير تـأكد من وضع موضوعك بقسم الطلبات واضغط الرقم 9 حبيبى من حضر القسمة فليقتسم لما يطلب راح اخبره يعمل حسابه على طلبين زيادة لينا لانى جعان جدا ههههههه بس بشرط لا احب الاسبايسي او الصودا اطلب كيف ما بدك وتدلل استاذ @kha9009lid الطلبات اليوم على حساب الاستاذ @عبد اللطيف سلوم

السلام عليكم استخدم هذا الكود قي محرر الأكواد Docmd.OpenForm "Form Name" أو استخدم معالج زر الأمر عند انشائه من خلال تفعيل المعالج كما بالصورة أو أرفق لنا صورة الماكرو المستخدم لفتح الفورم لتحديد موطن الخلل وجزاكم الله خيرا تمنياتي بالتوفيق

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

وعليكم السلام هذه 6 طرق ، برسائل وبدون ، وانا اخترت لك آخر واحدة منها ، وهي تعطيك شريط في اسفل شاشة الاكسس: . Option Compare Database Private Sub أمر10_Click() On Error GoTo Err_أمر10_Click 'Dim stDocName As String 'stDocName = "q1" 'DoCmd.OpenQuery stDocName, acNormal, acEdit '1 العمل بصمت وبدون اشعارات ' CurrentDb.Execute ("q1") '2 العمل بصمت وبدون اشعارات ' DoCmd.SetWarnings False ' DoCmd.OpenQuery "q1" ' DoCmd.SetWarnings True '3 العمل بصمت وبدون اشعارات ، ولكن بوجود ساعة ترابية تشير الى وجود عمل ' DoCmd.Hourglass True ' DoCmd.OpenQuery "q1" ' DoCmd.Hourglass False '4 عمل اشعار ثابت لمدة 3 ثوان في اسفل الشاشة ' Application.SetOption "Show Status Bar", True ' Application.Echo True ' Application.Echo False, "الاستعلام يقوم بالتحديث" ' ' DoCmd.SetWarnings False ' DoCmd.OpenQuery "q1" ' DoCmd.SetWarnings True ' ' PauseTime = 3: Start = Timer ' Do While Timer < Start + PauseTime ' DoEvents ' Loop ' ' Application.SetOption "Show Status Bar", False ' Application.Echo True '5 عمل اشعار متغير لمدة 3 ثوان في اسفل الشاشة ' Application.SetOption "Show Status Bar", True ' SysCmd acSysCmdSetStatus, "الاستعلام يقوم بالتحديث" ' DoCmd.SetWarnings False ' DoCmd.OpenQuery "q1" ' DoCmd.SetWarnings True ' ' PauseTime = 3: Start = Timer ' Do While Timer < Start + PauseTime ' DoEvents ' A = A + 1 ' If A / 50 = Int(A / 50) Then B = B & " . " ' SysCmd acSysCmdSetStatus, B & "الاستعلام يقوم بالتحديث" ' Loop ' Application.SetOption "Show Status Bar", False ' SysCmd acSysCmdClearStatus '6 عمل اشعار متغير لمدة 3 ثوان في اسفل الشاشة Application.SetOption "Show Status Bar", True SysCmd acSysCmdInitMeter, "الاستعلام يقوم بالتحديث", 5000 DoCmd.SetWarnings False DoCmd.OpenQuery "q1" DoCmd.SetWarnings True PauseTime = 3: Start = Timer Do While Timer < Start + PauseTime DoEvents A = A + 1 SysCmd acSysCmdUpdateMeter, A Loop Application.SetOption "Show Status Bar", False SysCmd acSysCmdClearStatus Exit_أمر10_Click: Exit Sub Err_أمر10_Click: MsgBox Err.Description Resume Exit_أمر10_Click End Sub . وهذا الرابط فيه البرنامج المرفق ، يعني خذ منه الكود وخليه في برنامجك : http://www.access-programmers.co.uk/forums/attachment.php?attachmentid=32438&stc=1&d=1275923825 . . والنتيجة Notification بطريقة البرامج المحترفة ، فوق ساعة الكمبيوتر . جعفر 876.msg styles.mdb.zip BalloonToolTipSample.mdb.zip

جزانا الله واياكم خير الجزاء الحمد لله الذى هدانا وما كنا لنهتدى لولا ان هدانا الله عزوجل ثانيا كل الشكر والامتنان لاستاذى القدير ومعلمى الجليل الاستاذ رمهان ــــــــــــــــــــــــــــــــــــــــــــــ وقت الشرح بسم الله الرحمن الرحيم انا فى اول الفكرة اتعاملت مع الموضوع بحيلة النسخ واللصق وسوف اشرح فكرة الحيلة الموجودة فى المشاركة شرح الكود على زر امر فى النموذج الذى يحمل اسم form3 Me.txt_no.SetFocus هنا يقوم بعمل تركيز على مربع النص باسم : txt_no وهذا التركيز يحدد كل القيم داخل مربع النص ثم DoCmd.RunCommand acCmdCopy هذا الكود يقوم بعمل نسخ وبما اننا قمنا فى سطر الكود السابق بعمل اختيار لمحتوى مربع النص بالتركيز عليه ثم بهذا السطر من الكود قمنا بعمل نسخ للمحتوى اكتملت الحيلة ولم ينقصها سوى لصق ما قنا بنسخه من مربع النص باقى الكود Dim stFrmName As String Dim stLink As String stFrmName = "form4" DoCmd.Close acForm, "form3" DoCmd.OpenForm stFrmName, , , stLink هو اغلاق النموذج الحالى ثم فتح النموذج الجديد ولاكمال العمليه وذلك بلصق القيم فى النموذج الجديد والذى يحمل اسم form4 استخدمت الكود الاتى على مربع النص المراد لصق القييم فيه مربع النص باسم Text0 الحدث عن التركيز على مربع النص DoCmd.RunCommand acCmdPaste وهذ الكود يقوم بخطوة لصق ما قمنا بنسخه سابقا ثم باقى الكود Text2.SetFocus نقل التركيز الى المربع الذى يليه ... ــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــ وبعد الحوار مع استاذى الجليل ومعلمى القدير الاستاذ رمهان جرت الامور فى مجرى مختلف تمام وبعد ان تشتت افكارى بطرح سؤال الاستاذ رمهان تخبطت افكارى قليلا وخفقت دقات قلبى قليلا واختفت من على وجهى الابتسامة بالفرحة من مشاركة استاذى الحبيب وتسارعت بداخلى الافكار بالنزعة الرمهانية حتى فتح الله تعالى على بالفكرة فى المرفق رقم 2 copy txt v.2.rar وقت الشرح قمت بعمل موديول باسم"mod_copey_txt" وللامانة العلمية وإحقاقا للحق نقلت الموديول من احد الامثلة من مكتبتى وقمت بإختزال الكود حتى صار على النحو التالى Public Function when_Open_form(ByVal strFormName As String) As Boolean Const conDesignView = 0 Const conObjStateClosed = 0 when_Open_form = False If SysCmd(acSysCmdGetObjectState, acForm, strFormName) <> _ conObjStateClosed Then If Forms(strFormName).CurrentView <> conDesignView Then when_Open_form = True End If End If End Function وهذا الموديول يجعل قيم الحقول متساوية لبعضها طبقا لاسم النموذج المصدر والنموذج الهدف كما سيلى فى الشرح ولكن دون الابقاء على النموذجين مفتوحين ولا حتى فتح نموذج بشكل مخفى الية العمل داخل القاعدة فى النموذج الاول باسم frm1 تم وضع كود برمجى على زر الامر وشرحه تفصيلا كالاتى DoCmd.OpenForm "frm2" وهذا السطر نريد منه فتح النموذج الثانى باسم frm2 ثم If when_Open_form("frm2") Then وهنا فى هذا السطر القاعدة if ثم قمت باستدعاء الموديول والذى من خصائصه كما سبق تنفيذ نسخ ولصق القيم من الحقول من النموذج المصدر frm1 الى النموذج الهدف frm2 وذلك بناء على قيم الحقول بين النموذجين فى الكود التالى بالاسطر القادمة [Forms]![frm2]![Text0] = [Forms]![frm1]![Text0] [Forms]![frm2]![Text2] = [Forms]![frm1]![Text2] [Forms]![frm2]![Text4] = [Forms]![frm1]![Text4] Else End If وبعد ذلك باقى الكود اغلاق النموذج الحالى"النموذج المصدر" frm1 ونفس الفكرة بين النموذجين الثالث والرابع الا اننى حددت مرع واحد فقط لنسخ القيم منه من نموذج المصدر الى نموذج الهدف الا اننى ذت فى نموذج الهدف النموذج الذى يحمل اسم frm4 هذا الكود فى حدث عند الفتح Private Sub Form_Open(Cancel As Integer) Text2.SetFocus End Sub وبما ان قيمة المربع الاول اصبحت موجوده بناء على القيمة من نموذج المصدر لا اريد التركيز عليه عند الفتح فوضعت هذا الكود لنقل التركيز الى المربع التالى فكرة خطرت على بالى اثناء الشرح ممكن استخدام قاعدة if لو ان المربع الاول لا يحتوى على قيم يتم وضع التركيز عليه عند الفتح لو اردنا ذلك ☺ بالتوفيق

عندما يكون المعلم رمهانى ☺ حتما يحاول ويجتهد التلميذ ان تكون النتيجة رمهانية صورة توضح الية العمل داخل قاعدة البيانات النموذج الثانى تكون كل قيم مربعات النصوص فيه مساوية لقيم مربعات نصوص النموذج الاول النموذج الرابع قية مربع النص الاول فقط تساوى قيمة مربع النص الاول فى النموذج الثالث copy txt v.2.rar

وعليكم السلام الامر هو: DoCmd.GoToRecord , , acLast ويعمل على جميع اصدارات الاكسس جعفر