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

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

وعليكم السلام في VBA ، في خانة البحث ، اكتب كلمة keycode ومنه فقيمتهم 33 و 34 وفي هذا الرابط المزيد: http://www.foreui.com/articles/Key_Code_Table.htm جعفر

وعليكم السلام عملت شوية تغييرات في الجدول ، وهذا كود الزر: Option Compare Database Public web As Object Private Sub cmd_Go_Click() 'Make a Reference Internet Explorer Set web = CreateObject("InternetExplorer.Application") 'Open the site with Internet Explorer web.Navigate Me.Site 'make it visible web.Visible = True 'wait until the page opens fully Do Until web.ReadyState = 4 Loop End Sub جعفر 579.test90.mdb.zip

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

أخي الكريم أبو حمزة جرب الكود بالشكل التالي Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim myPath As String, fullImagePath As String myPath = ThisWorkbook.Path & "\pic\" fullImagePath = myPath + [B1] If Target.Address = "$B$1" Then If Dir(fullImagePath & "1.JPG") <> "" Then Image1.Picture = LoadPicture(fullImagePath & "1.JPG") Else Image1.Picture = LoadPicture(myPath & "NO.JPG") End If '========================================================= If Dir(fullImagePath & "2.JPG") <> "" Then Image2.Picture = LoadPicture(fullImagePath & "2.JPG") Else Image2.Picture = LoadPicture(myPath & "NO.JPG") End If '========================================================= If Dir(fullImagePath & "3.JPG") <> "" Then Image3.Picture = LoadPicture(fullImagePath & "3.JPG") Else Image3.Picture = LoadPicture(myPath & "NO.JPG") End If '========================================================= If Dir(fullImagePath & "4.JPG") <> "" Then Image4.Picture = LoadPicture(fullImagePath & "4.JPG") Else Image4.Picture = LoadPicture(myPath & "NO.JPG") End If End If End Sub

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

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

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

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

وأخيراً تمت مشاركة ملف الإكسيل في شبكة محلية مع الموظفين وتم تبادل البيانات معهم والتعديل عليها.. تابعونا لمعرفة الخطوات.

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله ومع كل جديد في الإكسيل تقع عليه عيني اقوم على الفورم بإفادة إخواني به لنرتقي سوياً أقدم لكم اليوم طريقة نسخ بيانات نطاق محدد من مصنف مغلق ـ والموضوع إلى هنا ليس بجديد ... أم الجديد في الموضوع هو إمكانية نسخ النطاق إلى المصنف المفتوح الحالي بدون فتح المصنف المغلق على الإطلاق .. أي في الأكواد المستخدمة لن تجد كلمة Open ... إليكم الطريقة : قم بعمل مصنف وليكن باسم Sample.xlsx وضع به بعض البيانات في الـ 10 صفوف الأولى وفي الـ 10 أعمدة الأولى (هذا هو النطاق الذي سيتم نسخه إلى المصنف الحالي) ضع الكود التالي في موديول Sub GetDataFromClosedWorkbook() Dim FilePath$, Row&, Column&, Address$ 'Change Constants & Filepath Below To Suit '*************************************** Const FileName$ = "Sample.xlsx" Const SheetName$ = "Sheet1" Const NumRows& = 10 Const NumColumns& = 10 FilePath = ActiveWorkbook.Path & "\" '*************************************** DoEvents Application.ScreenUpdating = False If Dir(FilePath & FileName) = Empty Then MsgBox "The File " & FileName & " Was Not Found", , "File Doesn'T Exist" Exit Sub End If For Row = 1 To NumRows For Column = 1 To NumColumns Address = Cells(Row, Column).Address Cells(Row, Column) = GetData(FilePath, FileName, SheetName, Address) 'Columns.AutoFit Next Column Next Row ActiveWindow.DisplayZeros = False Application.ScreenUpdating = True End Sub Private Function GetData(Path, File, Sheet, Address) Dim Data$ Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & Range(Address).Range("A1").Address(, , xlR1C1) GetData = ExecuteExcel4Macro(Data) End Function وإليكم الملف المرفق فيه تطبيق الأكواد ... . أرجو أن ينال الملف إعجابكم وتستفيدوا منه إن شاء الله تعالي ... حمل الملف من هنا تقبلوا وافر تقديري واحترامي

السلام عليكم جرب الكود اتمنى ان يكون المطلوب Data base 1.rar

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

أخى الكريم تفضل الكود المطلوب أتمنى أن يفى بالغرض المطلوب تقبل تحياتى Data base By _ Mohamed EL_Desouky.rar

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

السلام عليكم 1. احذف العلاقات بين الجداول ، 2. في الجدول Table1 ، الحقل Country_Code والحقل City_Code ، اجعل العمود الثاني هو العمود الاساسي ، حينها سترى الكلمات ، لا الارقام ، 3. في حقل التجميع Code ، استخدم هذه المعادلة لتحصل على خانات الارقام الثلاث [Contry_code] & [City_code] & IIf(Len([Number])=1,"00" & [Number],IIf(Len([Number])=2,"0" & [Number],[Number])) والنتيجة جعفر 578.TEST.accdb.zip

الاخ العزيز انت عاوز استدعاء للاسم والمرتب فقط انظر الملف قمت بالعمل عليه امس مرتبات2.rar

وعليكم السلام في هذا الرابط تم مناقشة الموضوع بإسهاب جعفر

الأخ الكريمAhmedElsayed86 السلام عليكم لو الرقم موجود فى الخلية A1 للحصول على الجنيهات اكتب المعادلة التالية =INT(A1) وللحصول على القروش اكتب المعادلة التالية =(A1-INT(A1))*100

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

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

بارك الله فيك أخي العزيز أبو حنين وجزيت خيراً على مرورك العطر

اخى الحبيب ....ياسر ابو البراء دائما موجود ... حيث نحتاج وجودك جزاك الله كل الخير .... كود رائع رائع

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

السلام عليك أخي العزيز وشكراً على سرعة الإجابة , واعتذر عن التأخر في التعليق كون المثال الذي أرفقته لي أكسيس 2007 والأكسس الذي أعمل عليه أكسيس 2003 فأصطررت إلى شراء نسخة 2007 ولكن للأسف لم يعمل المثال , يرجى من جنابكم الكريم التفضل لو يكون المثال بأكسيس 2003 وشغال , مع فائق شكري وتقديري لك .

وعليكم السلام مشكور على كلماتك الطيبة أخي وحبيبي في الله محمود الشريف الأخ أبو حنين أعطيتك الكود وكان يجب تغيير ما يلزم حسب المعطيات (حاول دراسة الكود ستجد أن الموضوع بسيط .. يقتصر الآن فقط على الإشارة لكل مصنف (من وإلى ) وعلى حسب المعطيات التي تفضلت بها جرب الكود التالي (يوضع الكود في موديول عادي في المصنف المسمى TIME SHEET TAREK EK 2017) Sub zayed_allaw() Dim wbk As Workbook Const strInput = "Zayed Allaw Cairo.xlsx" Application.ScreenUpdating = False ThisWorkbook.Sheets("Zayed Allaw").Range("A1:X19").Copy On Error Resume Next Set wbk = Workbooks(strInput) If wbk Is Nothing Then Set wbk = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & strInput) If wbk Is Nothing Then MsgBox strInput & " Not Found!", vbCritical End If End If wbk.Sheets("Zayed Allaw").Range("A1").PasteSpecial xlPasteValues ThisWorkbook.Sheets("Zayed Allaw").Activate Range("A1").Select Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

تفضل أخي sandanet لقد قمت بإضافة الشريط إلى ملف و هو يعمل بشكل جيد تنقل بين الصفحات كما تشاء الأول الأخيرة السابقة التالية. report_options2.rar

السلام عليكم أخي أمير هذا الكود سوف يقوم بإعطاء نتيجة عدد الصفحات 0 و سوف يعمل الكود بشكل جيد إذا أضفنا للتقرير مربع نص و نكتب به [Pages] مع العلم أن تسمية مربع النص غير مهمة سمه كما تشاء

جرب هذا الماكرو (تستبدل اسم اخر شيت الى Repport لحسن التعامل مع اللغة الاجنبية) مرفق الملف Sub copy_spcial_cells() Dim Ws_Source As Worksheet Dim My_Sheet As Worksheet Dim My_NUm, x, s, lr, k, i As Integer Dim My_Rg As Range Set Ws_Source = Sheets("Repport") With Ws_Source .Select .Range("a4:d1000").ClearContents My_NUm = .Range("b1") End With x = 4 k = Sheets.Count For i = 1 To k - 1 Set My_Sheet = Sheets(i) lr = My_Sheet.Cells(Rows.Count, "e").End(3).Row If lr < 5 Then lr = 5 For s = 5 To lr If Sheets(i).Range("E" & s) = My_NUm Then With Ws_Source .Range("a" & x) = My_Sheet.Range("b1") .Range("b" & x) = My_Sheet.Range("b2") .Range("c" & x) = My_Sheet.Range("b" & s) .Range("d" & x) = My_Sheet.Range("a" & s) End With x = x + 1 End If Next Next End Sub Report salim.rar

أخى فى الله وأستاذى القدير // ياسر خليل عن جد روعاتك يا أبو البراء أنت بحق برنس

اذا كنت تقصد اظهار عدد الصفحات داخل التقرير: فاستخدم معالج انشاء التقرير وسوف يظهر تلقائيا رقم الصفحة واجمالي الصفحات واذا كنت تقصد اظهار عدد الصفحات داخل نموذج : Private Sub Command0_Click() strReportName = "table1" DoCmd.OpenReport strReportName, acViewPreview, , , acHidden MsgBox (Reports(strReportName).Pages) DoCmd.Close acReport, strReportName, acSaveNo End Sub

الملف ليس مغلق كل ما فيه أنه قام بإخفاء الأعمده والصفوف والتعامل فقط من خلال اليوزر فورم التى تظهر لك

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

وعليكم السلام جرب الكود التالي (لم أجربه لأنه لا يوجد ملف مرفق) ،والطلب غير واضح حيث يجب تحديد اسم المصنف الحالي واسم ورقة العمل والنطاق المطلوب التعامل معه ، وكذلك المصنف الآخر المطلوب نسخ البيانات إليه وورقة العمل والنطاق المطلوب نسخ البيانات إليه ... عموماً جرب الكود وغير ما يلزم (المهم هنا الفكرة) Sub zayed_allaw() Const strInput = "TIME SHET ZAYED.xlsx" Application.ScreenUpdating = False ThisWorkbook.Sheets("Sheet1").Range("A1:X19").Copy On Error Resume Next Set wbk = Workbooks(strInput) If wbk Is Nothing Then Set wbk = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & strInput) If wbk Is Nothing Then MsgBox strInput & " Not Found!", vbCritical End If End If Windows("TIME SHET ZAYED.xlsx").Activate Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A1").Select Windows("TIME SHEET TAREK EK 2017.xlsb").Activate Application.CutCopyMode = False Range("A1").Select Application.ScreenUpdating = True End Sub

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

استاذ أبو عيد ممكن تشرحلي شوية على الكود الي عمله الاستاذ ابو البراء هوه اشتغل تمام وعملت له اختبار وعمله 100% (سواء معادلة او كود) لكن ما فهمتش طريقة عمله احسه مبهم شوية عشان ممكن في أي وقت تتغير المدة الدنيا والقصوى او ممكن رقم المستوى يتغير واريد ان افهم الكود عشان استطيع اني اغير بسهولة طلبي المستوى الدنبا القصوى 3 365 545 5 545 730 7 730 910 1 .. .. OFF .. .. احتمال كبير جدا خلال 6 اشهر يكون فيه مدة دنيا وقصوى ل OFF وممكن يضاف رقم مستوى جديد مثل (2 او 4 او 6) في هذه الحالة لا اعرف كيف اعدل على الكود ارجوا ان لا تعتبر اني قد تجاهلتك بالسؤال بعد اجابة الاستاذ ابو البراء ولكن من حسن نية وجدته وضع الكود فقمت بسؤاله ولذلك فلك جزيل الشكر اخي الحبيب

السلام عليكم ورحمة الله تفضل Salary Data.rar

الى حضرتك التعديل time-off.rar

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

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

::: اهلا بك اخي ... برايي طالما جداولك الثلاثة متشابهه في الحقول تقريبا فمن الافضل هنا ان تعمل جدول واحد بضمنة حقل القسم المتغير ...اختيار للقسم فقط . ::: اتمنى ان يكون طلبك . Ahmed_UP.rar

استخدم الاستعلام

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

تفضل A1 = "[امتار الإنتاج]" A2 = "امر التشغيل" A3 = "لوحة تحكم" A4 = "تاريخ الصب" A5 = "المنتج" A6 = "نوع" Me.n1 = DSum("[A1]", "A2", "[A6]='" & [Forms]![A3]![M] & "' AND [A5]='" & [Forms]![A3]![B2] & "' AND [A4]=#" & [Forms]![A3]![MM] & "#") يعني استعمل الكود التالي ، وذلك بعدما ضبطناه في السطر السابق Me.n1 = DSum("[امتار الإنتاج]", "امر التشغيل", "[نوع]='" & [Forms]![لوحة تحكم]![M] & "' AND [المنتج]='" & [Forms]![لوحة تحكم]![B2] & "' AND [تاريخ الصب]=#" & [Forms]![لوحة تحكم]![MM] & "#") وعلشان نضع صفر بدل الحقل الفارغ Me.n1 = NZ(DSum("[امتار الإنتاج]", "امر التشغيل", "[نوع]='" & [Forms]![لوحة تحكم]![M] & "' AND [المنتج]='" & [Forms]![لوحة تحكم]![B2] & "' AND [تاريخ الصب]=#" & [Forms]![لوحة تحكم]![MM] & "#"),0) جعفر

اخي الكريم اتبع الآتي .. اخفي النماذج والاستعلامات والجداول والوحدات النمطية - اقفل الوحدات النمطية بباسوورد - اخفي شاشة الاكسس الخلفية - استخدم كود لقفل مفتاح الشفت مع بداية تشغيل البرنامج - قم بازالة جميع علامات الصح من tools > startup مباشرة قبل تحويلك الملف الى MDE بعد عمل تلك الخطوات فان العميل لايمكنه التعديل لافي الاكواد ولا في النماذج لكن تبقى بيانات الجداول معرضة للتلاعب ولحل هذه المشكلة فانه بامكانك تشفير بيانات الجداول بينما يقوم البرنامج بفك تشفير تلك البيانات اثناء الفتح ويعيد تشفيرها اثناء الاغلاق تحياتي

جرب هذا الماكرو Sub copy_All() Application.ScreenUpdating = False Dim My_sh As Worksheet Dim My_range As Range Dim k, m, lr, i As Integer k = Sheets.Count m = 3 Set My_sh = Sheets(k) My_sh.Range("a3:m1000").ClearContents For i = 2 To k - 1 With Sheets(i) lr = .Cells(Rows.Count, 1).End(3).Row Set My_range = .Range("a6:k" & lr) End With With My_sh .Cells(m, 1) = Sheets(i).Cells(1, 2) .Cells(m, 2) = Sheets(i).Cells(2, 2) My_range.Copy .Range("c" & m).PasteSpecial xlPasteValues m = m + lr - 4 End With Next My_sh.Activate Range("a3").Select Application.ScreenUpdating = True End Sub

وعليكم السلام الكود السابق كان يستعمل سجلات الجدول fatora ، بينما الكود التالي يستخدم سجلات مصدر النموذج ، والذي هو الاستعلام esfatora : CurrentDb.Execute ("UPDATE esfatora SET done =" & Not Me.done) جعفر

حيا الله اخوي شفان للعلم ، وهذا الكود كذلك يعتمد على الامر Not الشئ الذي يجب ان يكون على بالنا وقت المشاركة في اي من المواضيع: هذا المنتدى للتعلّم وتعليم الاخرين ، لذلك ، بعض الاوقات ترى اني اضع اكثر من طريقة لحل الموضوع ، وبعض الاوقات اضع توضيح لكل سطر ، وبعض الاوقات افكك الحل لأسطر اكثر حتى يكون سهل على الشباب تغييره لاحقا ، وبعض الاوقات تحذير عن الوقوع في خطأ ومثل ما هو مكتوب في اسفل مواضيعي: في اعتقادي ، مشاركة أكثر من شخص في الرد على السؤال ، هو فائدة للجميع ، فمنه نتعلم الطرق الاخرى للإجابة على السؤال ، ونتعلم خبايا البرمجة فبمشاركة الاخ صالح ، اصبح هذا الموضوع اكثر اثراءً جعفر

التعديل جميل ايش رايك نقلل الكود الذي وضعته انت ، بواسطة الامر Not ، ومعناه ، غيّر القيمة الحالية الى القيمة التي ليست فيه: Dim f As Boolean Dim rst As DAO.Recordset Set rst = Me.RecordsetClone rst.MoveLast: rst.MoveFirst RC = rst.RecordCount f = rst!done For i = 1 To RC rst.Edit rst!done = Not f rst.Update rst.MoveNext Next i rst.Close: Set rst = Nothing End Sub . جعفر ونعم كنت على علم بهذا ، ولكني كنت اعتقد بأن المبرمج كان سيقفل على المستخدمين تغيير الحقل يدويا ، وبالتالي تكون المشكلة تم حلها ولكن ، وحتى بالحليين (الحل الثاني الذي تركته انا في الكود الاصلي) ، وحتى الطريقة التي تفضلت بها انت ، فنحن نعتمد على قيمة اول حقل ، وربما لم يكون صحيحا ، لذا سيضطر المستخدم الى الضغط على زر التغيير مرتين (بعض الاوقات للحصول على القيمة الصحيحة) جعفر

وعليكم السلام تفضل Private Sub cmd_Select_All_Click() '1 ' Dim rst As DAO.Recordset ' Set rst = Me.RecordsetClone ' rst.MoveLast: rst.MoveFirst ' RC = rst.RecordCount ' ' For i = 1 To RC ' rst.Edit ' rst!done = Not rst!done ' rst.Update ' ' rst.MoveNext ' Next i ' ' rst.Close: Set rst = Nothing '2 CurrentDb.Execute ("UPDATE fatora SET done =" & Not Me.done) Me.Requery End Sub . جعفر