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

السلام عليكم 🙂 اليكم طريقتي . وهذا هو الكود ، ولكن تذكر ان تحذف السطر الذي لا تريده : Dim ID As Long Dim ID As String ID = Me.txtID Me.Requery Me.RecordsetClone.FindFirst "[ID]=" & ID Me.RecordsetClone.FindFirst "[ID]='" & ID & "'" Me.Bookmark = Me.RecordsetClone.Bookmark . وهذه الطريقة اعلاه ، ولكنها غير مختصرة : . وهذا هو الكود ، ولكن تذكر ان تحذف السطر الذي لا تريده : Dim rst As dao. Recordset Dim ID As Long Dim ID As String ID=Me.txtID Me.Requery Set rst = Me.RecordsetClone rst.FindFirst "[ID]=" & ID rst.FindFirst "[ID]='" & ID & "'" Me.BookMark=rst.RecordsetClone.BookMark جعفر

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

السلام عليكم مشاركة مع الاساتذه الاعزاء تفضل اخي الكريم اتمنى ان يكون المطلوب تحياتي Dental.rar

بعد اذن اساتذتنا الافاضل @أحمد الفلاحجى و @محمد ابوعبد الله اذا كنت ترغب في استخدام الامر Me.Requery يمكن عملها عن طريق Dim x As Integer x = CurrentRecord Me.Requery Me.PCode.SetFocus DoCmd.FindRecord x, acAnywhere, , acSearchAll حجز متغير باسم x المتغير يساوي السجل الحالي تحديث نقل التركيز للحقل pcode البحث عن السجل الى كنا واقفين عليه في خاصية النموذج حقل pcode كان غير ممكن وغيرته الى ممكن النموذج مرفق بالتأكيد توجد طرق اخرى ولكن هذا ماجاء على بالي واعذرني في حالة عدم الرد لا نشغالي في ضل الاوضاع الكرونية اجارنا الله جميعا منها Dental.accdb

بارك الله فيك استاذ أحمد وزادك الله من فضله

يمكنك مشاهدة هذا الفيديو https://www.youtube.com/watch?v=CpR8QvC6pAA

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

أحسنت أستاذ منير موفق ان شاء الله عمل ممتاز

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

وعليكم السلام -اهلا بك فى المنتدى ,لك ما طلبت fixed Time.xlsm

هذه العلامة طالما انك تريد من المعادلة العد فلابد من وضعها واذا جربت ازالتها فلم يخرج الناتج كما تريد

جزاكم الله خيرا اخوانى واساتذتى @محمد ابوعبد الله @kha9009lid @jjafferr @خالد سيسكو

آسف اخوي خالد 🙂 بعد ان وضعت المشاركة ، واذا بها اخطاء في التنسيق ، فإستخدمت صلاحياتي ، وقمت بالتعديلات بعيد عن الاعين 🙂 عندنا مثل عماني يقول : اللي في يده القلم ، ما يكتب على عمره شقي 🙂 جعفر

بدل ان يكون عندك حقل صورة ، خليه حقل نص ، ثم اكتب نفس المعادلة اعلاه ، ولكن بتغيير اسم الحقل الذي في النموذج (الاسم وليس مصدر البيانات) 🙂 جعفر

شوف هذا الرابط ، قد يفيدك 🙂 جعفر

See This file calculation.xlsx

وهذه طريقتي 🙂 انا تعمدت وخليت التقرير طويل ، علشان يبان الجمع لأكثر من صفحة ، وطبعا انت لاحقا اعمله بالحجم اللي يناسبك 🙂 . . والنتيجة : الصفحة 1 ومجموعها : . والصفحة 2 ومجموعها + مجموع ما قبلها: . جعفر 1189.الكمية444.accdb.zip

تفضل 201.xlsx

اخي الفاضل 🙂 للتوضيح : . بالنسبة لـ نعم / لا او صح / خطأ او تشغيل / إيقاف تشغيل : فهو ليس زر ، وإنما اختيار ، وهناك 3 اشكال له (كما هو واضح من الصورة اعلاه) ، والكود عادة نضعه على الحدث "بعد التحديث" ، ويكون في حالتين ، عند اختياره تكون قيمته تساوي -1 ، وعند عدم الاختيار تكون قيمته صفر (وهناك حالة ثالثه خاصة لهم ، وهي حالة Null) ، عند وضع المعيار (في الاستعلام مثلا) ، وبسبب ان الكائن ممكن يكون في 3 حالات (حالة الصفر وحالة Null معناهما انه لم يتم الاختيار) ، لذا ، فالافضل هو ان نستعمل: اذا كنا نريد الحقول المختارة ، فيكون الاختيار -1 ، بينما اذا اردنا الحقول الغير مختارة ، فيكون الاختيار <>-1 جعفر

السلام عليكم تفضل اخي الكريم طلبك رسالة بعد 3 ثوان تختفي يمكنك كذلك تغيير عدد الثواني تحياتي 222.rar

السلام عليكم تفضل اخي الكريم فقط اضغط على زر تحديث اتمنى يكون المطلوب تحياتي 222.rar

وعليكم السلام ورحمة الله وبركاته اذا كان نوع الحقل نص استخدم الكود التالي rs.FindFirst "[id] ='" & Me![text1] & "'" اذا كان نوع الحقل تاريخ استخدم الكود التالي rs.FindFirst "[id] = #" & Me![text1] & "#" اذا كان نوع الحقل رقم استخدم الكود التالي rs.FindFirst "[id] = " & Me![text1] تحياتي

وعليكم السلام -يمكنك استخدام هذه المعادلة =SUMPRODUCT(--($H$10:$H$20=$N1),SUBTOTAL(2,OFFSET($G$10:$G$20,ROW($H$10:$H$20)-ROW(H10),0,1))) فلترة1.xlsx

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

السلام عليكم 🙂 هناك الكثير من الميزات/الاوامر التي يعطينا برنامج الاكسس ، والتي يمكن ان نعمل لها بديل ، ولكن يكون هناك فرق في سرعة تنفيذ كودنا مقارنة مع الكود الاصل من الاكسس !! مثل القائمة المختصرة التي تظهر لنا بالنقر على زر الفأرة الايمن ، والتي بها يمكننا ان نستغني عن الكثير الاوامر ، مثل الفرز والتصفية بأنواعه ، ولكن وللأسف الشديد ، فأنا ارى ان 99.99% من البرامج ، يتم حذف هذه القائمة وعدم تفعيلها ، والسبب ان المستخدم يستطيع ان يدخل في تصميم النموذج من خلال هذه الاوامر(في الدائرة الحمراء) : و . ويضطر المبرمج ان يعوض بقية الاوامر في القائمة ، بمجموعة من الازرار ، او بطرق مختلفة !! ----------------------------------------------------------------------------------------------- الاكسس يسمح لنا ان نعمل قوائم مختصرة Shortcut Menu والتابعة لمجموعة CommandBars ، حسب احتياجنا ، ونختار ما نضعه فيها 🙂 هناك 3 انواع من هذه القوائم : الثابته ، والمؤقته ، والمؤقته التي تحتاج الى كود. الثابته: وهي التي عندما نعملها ، تصبح مستقله عن الكود ، وتُحفظ وتبقى في قاعدة البيانات بعد إغلاقها ، ويمكننا ان نستوردها في قاعدة بيانات اخرى عندما نستورد احد/جميع كائنات قاعدة البيانات الآخرى ، بإستخدام : . ونختارها في النموذج : . او التقرير : . هذا مثال لعمل الكود الاساس لعمل قائمة قطع/نسخ/لصق : Option Compare Database Option Explicit Dim cmb As Object Dim cmbCtrl As Object Dim cmbName As String ' ' ' to use: ' Dim cbr As Commandbar ' Dim cbrButton as CommandbarControl ' ' we have to select in the References: ' Microsoft Office xx.x Object Library ' Public Function SCM_Copy(Optional DeleteMe As Boolean = False) On Error Resume Next 'If menu with same name exists delete cmbName = "cmb_Copy" CommandBars(cmbName).Delete If DeleteMe = True Then Exit Function If Err.Number <> 0 Then Err.Clear Set cmb = CommandBars.Add(cmbName, msoBarPopup, False, False) With cmb .Controls.Add msoControlButton, 21, , , False ' Cut .Controls.Add msoControlButton, 19, , , False ' Copy .Controls.Add msoControlButton, 22, , , False ' Paste End With Set cmb = Nothing End Function . وشرح الكود : 1. اسم القائمة المختصرة ، والتي سوف نختارها في النموذج او التقرير ، 2. هذه المجموعة الاساس منبثقة Popup ، 3. بينما هذه المجموعات عبارة عن ازرار Buttons ، وقد تكون قائمة منسدلة Combobox ، او نص Edit نُدخل فيه قيمة معينة للتصفية مثلا ، 4. هل هذه القائمة مؤقته ؟ False معناها ثابته وتُحفظ في قاعدة البيانات ، بينما True معناها انها مؤقته وتعمل لما ننادي الوحدة النمطية/الكود ، 5. هذه ارقام كل امر ، وملف الاكسل المرفق من مايكروسوفت فيه جدول يضم جميع ارقام الاوامر للاكسس 2010 () ، 6. اذا اردنا ان نحذف هذه القائمة ، فننادي الوحدة النمطية بضم True في امر المناداة المؤقته: ونستعمل True في مكان الرقم 4 اعلاه. وهي التي عندما نعملها ، لا تصبح مستقله عن الكود ، ولا تبقى في قاعدة البيانات بعد إغلاقها ، ولا يمكننا ان نستوردها في قاعدة بيانات اخرى عندما نستورد احد/جميع كائنات قاعدة البيانات الآخرى (كما هو الحال مع القائمة الثابته) ، ويجب ان نستخدم "حدث فتح" النموذج/التقرير لعملها واستخدامها في النموذج/التقرير ، و "حدث اغلاق" النموذج/التقرير لحذفها ، طيب ، خلونا نعمل هذه القائمة : Public Function SCM_Copy_Sort(Optional DeleteMe As Boolean = False) On Error Resume Next 'If menu with same name exists delete cmbName = "cmb_Copy_Sort" CommandBars(cmbName).Delete If Err.Number <> 0 Then Err.Clear Set cmb = CommandBars.Add(cmbName, msoBarPopup, False, False) With cmb Set cmbCtrl = .Controls.Add(msoControlButton, 21, , , False) ' Cut cmbCtrl.Caption = "Cut..." cmbCtrl.FaceId = 21 Set cmbCtrl = .Controls.Add(msoControlButton, 19, , , False) ' Copy cmbCtrl.Caption = "Copy..." cmbCtrl.FaceId = 19 Set cmbCtrl = .Controls.Add(msoControlButton, 22, , , False) ' Paste cmbCtrl.Caption = "Paste..." cmbCtrl.FaceId = 22 Set cmbCtrl = .Controls.Add(msoControlButton, 210, , , False) 'Sort Ascending cmbCtrl.BeginGroup = True cmbCtrl.Caption = "فرز تصاعدي..." cmbCtrl.FaceId = 210 Set cmbCtrl = .Controls.Add(msoControlButton, 211, , , False) 'Sort Decending cmbCtrl.Caption = "فرز تنازلي..." cmbCtrl.FaceId = 211 End With Set cmb = Nothing End Function . وشرح الكود: احنا توسعنا في الكود الاساسي ، واضفنا له : 1. تسمية اختيارية غير الافتراضية ، لاحظ في الصورة اعلاه اني استعملت الانجليزي والعربي ، 3. وهو لعمل خط فاصل في الصورة بين مجموعة قطع/نسخ/لصق ومجموعة فرز تصاعدي/تنازلي ، . 2. ممكن ان نبدل الصورة الافتراضية التي تيجي مع الرقم ، بتبديل هذا الرقم (لاحظ صورة الاسهم للتصاعدي/التنازلي) : . ومرفق ارقام جميع الصور الموجودة في الاكسس : . . . . . . . . . . . في قاعدة البيانات المرفقة myRight_Click.mdb ، بالاضافة الى القوائم الثابته اعلاه ، تم اضافة هذه القائمة ايضا : . والتقرير يحتوي على القائمة المؤقته التالية : . - ملف الاكسل myList.xlsx ، اخترت فيه اهم القوائم في وجهة نظري ، - ملف الاكسل AccessControls_2010.xlsx ، من مايكروسوفت ، يحتوي على جميع الاوامر 🙂 جعفر المصادر: http://dev-soln.com/access-shortcut-right-click-tool/ https://www.experts-exchange.com/articles/12904/Understanding-and-using-CommandBars-Part-II-Creating-your-own.html https://filedb.experts-exchange.com/incoming/2014/02_w06/833359/CommandBars-II.mdb https://www.experts-exchange.com/articles/18341/CommandBars-Part-III-Using-Built-in-Shortcut-Menus.html http://www.skrol29.com/us/vtools.php AccessControls_2010.xlsx myList.xlsx myRight_Click.zip

شكرا بارك الله فيك .. تمت التجربة وتعمل بصورة صحيحة 100 100☺️☺️

استاذ @jjafferr دخلت لوضع شكر لمشاركتك وما وجدتها 😃

استبدل الكود كالتالي Me.Requery بهذا Me.Refresh كما انصحك باستبدال اسم زر الامر من Requery الى اي اسم اخر مثل XRequery تحياتي

بعد اذن الاخ علي خيار ثاني في الخلية F10 هذه المعادلة =SUMPRODUCT($D$5:$D$7,$E$5:$E$7)*$F$9 في الخلية F11 هذه المعادلة =SUMPRODUCT($D$5:$D$7,$E$5:$E$7)*(1-$F$9) file included 203.xlsx

اخي jo 🙂 انت عندك موضوع اكبر من اللي اخبرتنا عنه 🙂 فجواب سؤالك: '1 Private Sub AA_AfterUpdate() Me.BB = -1 End Sub '2 Private Sub AB_Click() Me.AA = -1 End Sub . جعفر

هايل وشكرا على المجهود

Option Explicit Option Base 1 Sub My_code() Dim m%, k%, lr%, i% Dim Main As Worksheet, sh As Worksheet Dim myArray, arr(11), targt$ Set Main = Sheets("Allstudents") Set sh = Sheets("from.school") sh.Range("B7:M1000").Clear targt = "from*" lr = Main.Cells(Rows.Count, "D").End(xlUp).Row m = 7 For i = 3 To 13 arr(i - 2) = i Next myArray = Array(38, 4, 5, 27, 13, 16, 18, 19, 20, 21, 22) For i = 5 To lr If Main.Cells(i, "AD") Like "*" & targt Then For k = 1 To 11 sh.Cells(m, arr(k)) = Main.Cells(i, myArray(k)) Next m = m + 1 End If Next With sh.Range("B7").Resize(m - 7, 13) .Borders.LineStyle = 1 .HorizontalAlignment = 1 .InsertIndent 1 With .Font .Bold = True .Size = 14 End With '++++++++++++++++++++++++++++++++++++++++++++++++++++++ ' الرقم 10 هنا يرمز الى رقم العامود في الجدول حيث يوجد التاريخ 'أقصد العمود K .Columns(10).NumberFormat = "yyyy/m/d" '+++++++++++++++++++++++++++++++++++++++++++++++++++++++ End With End Sub الكود بعد كل الاضافات التي تمت بارك الله في الاستاذ سليم وبارك الله في كل من يساعد على نشر العلم وليس اغلاقه

مشكور استاذ العزيز على هاذا الابداع الله يحفظك ويبارك بجهودك تحياتي

عند اذن يجب استعمال هذا الماكرو Option Explicit Sub ADD_S_with_Hyper() 'code to add Sheets One Time WITH HYPERLINKS 'Crated By Salim Hasbaya On 17/03/2020 Dim rg As Range, Rg_copy As Range Dim Title_rg As Range, Past_rg As Range Dim S As Worksheet Dim LB%, K%, i% Dim x Dim ws As Worksheet Set S = Sheets("Salim") Set Title_rg = S.Range("a6").Resize(2, 67) Application.ScreenUpdating = False LB = S.Cells(Rows.Count, 2).End(3).Row For Each rg In S.Range("B8:B" & LB) If rg.Value <> "" Then If Not Application.Evaluate("ISREF('" & rg.Value & "'!A1)") Then Sheets.Add(After:=Sheets(Sheets.Count)).Name = rg.Value With ActiveSheet .Hyperlinks.Add Anchor:=.Range("D1"), Address:="", SubAddress:= _ "SALIM!B2", TextToDisplay:="Goto SALIM" .Cells(1, 2) = rg .Columns("A:A").AutoFit .Columns("D:D").AutoFit End With End If End If Next rg With Sheets("Salim") .Hyperlinks.Delete For i = 8 To LB x = Application.CountIf(S.Range("B2:B" & i), S.Range("B" & i)) If x = 1 Then .Hyperlinks.Add Anchor:=.Range("B" & i), Address:="", SubAddress:= _ "'" & .Range("B" & i) & "'!B1", TextToDisplay:=.Range("B" & i).Value S.Range("B" & i).Font.Underline = False S.Range("B" & i).Font.Size = 16 Else S.Range("B" & i).Font.Underline = False S.Range("B" & i).Font.Size = 16 End If Next .Select With S.Range("b8:b" & LB) .HorizontalAlignment = 1: .Font.ColorIndex = 1 .Font.Bold = -1: .InsertIndent 1 .Borders.LineStyle = 1 End With For i = 8 To LB Set ws = Sheets(S.Range("B" & i) & "") Title_rg.Copy ws.Range("a6").PasteSpecial Set Rg_copy = S.Range("A" & i) Set Past_rg = ws.Range("A8") Call give_data(Rg_copy, Past_rg, 67) Application.CutCopyMode = False Next Application.ScreenUpdating = True End With End Sub '++++++++++++++++++++++++++++++++ Sub give_data(S_rg As Range, Target_rg As Range, n As Integer) S_rg.Resize(, n).Copy Target_rg.PasteSpecial Target_rg.Offset(, 1).Resize(, n - 1).Columns.AutoFit End Sub الملف من جديد ISHAAR_2.xlsm

وهذا هو الملف الخاص بقوائم الفصول نسخة_من_قوائم_الفصول_الاصدار_8.rar

السلام عليكم الملف الاول التعديل بدالة iif عن طريق الاستعلام الملف الثاني التعديل بدالة if عن طريق النموذج الملف الثالث التعديل بدالة Select Case تحياتي math.rar math 2.rar Select Case.rar

تفضل كل ما تريد واعتقد ان لا تحتاج غير ذلك توضيح2.xls

تفضل لاحظ ايهما تريد الحل بالعمود D ام الحل الموجود بالعمود E توضيح2.xls

أخى الكريم لماذا لا ترى الملف اذا رأيت الملف لوجدت ان مدى معرف مسبقا وهذا هو الملف protect non empty data with Pass word.xlsm

يمكنك مشاهدة هذا البرنامج ACCOUNT SOFTWARE W-COST CENTERS - V1.1.rar

بارك الله فيك

جزاك الله كل خير-أحسنت

أخى الكريم لما لا تستخدم خاصية البحث فى المنتدى قبل رفع المشاركة فهناك العديد من المشاركات تناولت هذه المواضيع ومنها : https://www.officena.net/ib/topic/85960-طلب-برنامج-مخازن/?tab=comments#comment-545203 https://www.officena.net/ib/topic/81355-طلب-مساعدة-في-يرنامج-ادرة-مخزن-بسيط/?tab=comments#comment-518943 https://www.officena.net/ib/topic/80160-تسيير-مخزن/?tab=comments#comment-512690 بارك الله فيك

بارك الله فيك-أحسنت

أحسنت استاذ سليم بارك الله فيك وجعل الله هذا العمل فى ميزان حسناتك

تفضل انظر الى الصورة حتى تقوم بوضح الكود فى حدث الورقة وهذا هو الكود الذى سيتم وضعه: Dim tt As Variant Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Not Intersect(Target, Range("PRot_range")) Is Nothing And Target.Address <> "$A$1" Then m = Target.Count c = [AA1] k = tt If IsEmpty(k) Then GoTo 1 If m * c >= 1 Then Application.EnableEvents = False my_pass = Application.InputBox(" áÇ íãßä ÇáÊÚÏíá Ýí åÐå ÇáÎáíÉ.... " _ & Chr(10) & "ÇáÇ ÈÍÇáÇÊ ÎÇÕÉ ÊÊØáÈ ßáãÉ ãÑæÑ", "password") If my_pass = "pass" Then GoTo 1 Application.Undo Application.EnableEvents = True End If End If 1: Application.EnableEvents = True End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) tt = Selection.Value End Sub

اهلا بك اخ كريم فى المنتدى تفضل ل 64 بت 64 Bit-اخفاء الاطار الخارجى للفورم.xlsm

تفضل classement des 222223.xlsx

تفضل اخى الكريم اخفاء الاطار الخارجى للفورم.xlsm

انا طالب علم وهانا تعلمت معلومه جديدة من استاذى الجليل ومعلمى القدير ووالدى الحبيب الاستاذ @jjafferr اسال الله تعالى لكم الخير كله واسال الله تعالى لكم البركة فى العمر والعلم والعمل والاهل والولد وان يغفر لكم ولوالديكم ولكل المسلمين ان شاء الله التعديل والتطبيق على المرفق بلمسات ساحر الاكسس الاستاذ @jjafferr Run Button Command _ up_by_ mr jjafferr .rar اسألكم الدعاء بظهر الغيب لوالدتى