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

ما ذكرة أخي @kha9009lid صحيح لكن جرب هذا المرفق لربما يخرجك من مأزق 2 مليون اسم مكرر مثال (5).accdb

السلام عليكم ورحمة الله تم وضع التنسيق الشرطي حسب ما تريد في خلايا العمود (العمود المعني)... New (2).xlsx

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

بسم الله الرحمان الرحيم و الصلاة و السلام على أشرف المرسلين أما بعد: سوف نقوم اليوم إن شاء الله بشرح أداة WebBrowser وأهم ما يتعلق بها من أوامر و أحداث و خصائص و إدخال و إخراج. و سوف يتم تقسيم هذا العمل إلى مجموعة حلقات نبدأ من الصفر حتى آخر نقطة نستطيع الوصول إليها إن شاء الله مع وضع مثال تطبيقي لكل حلقة. مقدمة: WebBrowser هي أداة تعمل عمل أي متصفح و هي مقترنة المتصفح الشهير Internet Explorer فهي تساعدك في تصفح المواقع من ناحية و التحكم في أكواد HTML وكل ما يرتبط بها من إدخال و استخراج بيانات من ناحية أخرى. ملاحظة: لتشغيل هذه الأداة بشكل جيد يجب تحديث المتصفح الشهير Internet Explorer إلى الإصدار 10 أو 11. مع العلم أن ونداوز 10 به الإصدار 11 الحلقة الأولى: أكواد التصفح سوف نتطرق في هذه الحلقة إلى الأكواد التي تمكننا من التصفح و التنقل داخل الأداة. 1- كود فتح صفحة موقع: WebBrowser3 هو اسم الأداة داخل النموذج Me.WebBrowser3.Navigate ("رابط الصفحة كامل") 2- كود فتح صفحة فارغة: Me.WebBrowser3.Navigate ("about:blank") 3- كود الرجوع للصفحة السابقة: Me.WebBrowser3.GoBack 4- كود الإنتقال للصفحة التالية: Me.WebBrowser3.GoForward 5- كود إعادة تحميل الصفحة: Me.WebBrowser3.Refresh 6- كود إيقاف تحميل الصفحة: Me.WebBrowser3.Stop 7- كود إستخراج رابط الصفحة الحالية: MsgBox Me.WebBrowser3.Document.url و هذا مثال لما تم ذكره في هذه الحلقة webbroser.rar

الحلقة الثانية: أكواد الطباعة و الخصائص و... سوف نتطرق في هذه الحلقة إلى الأكواد التي تمكننا من طباعة صفحة الويب و حفظها و عرض خصائص الصفحة و غيرها... 1- كود طباعة الصفحة: Me.WebBrowser3.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DODEFAULT 2- كود معاينة طباعة الصفحة: Me.WebBrowser3.ExecWB OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT 3- كود عرض خصائص الصفحة: Me.WebBrowser3.ExecWB OLECMDID_PROPERTIES, OLECMDEXECOPT_DODEFAULT 4- كود حفظ صفحة الويب: Me.WebBrowser3.ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_DODEFAULT 5- كود تنسيق الصفحة: Me.WebBrowser3.ExecWB OLECMDID_PAGESETUP, OLECMDEXECOPT_DODEFAULT 6- كود عنوان رابط الصفحة: MsgBox Me.WebBrowser3.LocationName 7- كود رابط الصفحة: MsgBox Me.WebBrowser3.LocationURL 8- كود فتح الصفحة الإفتراضية للمتصفح: Me.WebBrowser3.GoHome 9- كود فتح صفحة البحث: Me.WebBrowser3.GoSearch 10- كود فتح صندوق التصفح: هذا الكود يقوم بفتح صندوق لإدخال رابط صفحة ويب جديدة Me.WebBrowser3.ExecWB OLECMDID_OPEN, OLECMDEXECOPT_DODEFAULT 11- كود تخطي رسائل الأخطاء التي تظهر من الأداة عند التصفح: Me.WebBrowser3.Silent = True وهذا المرفق بعد الإضافات الجديدة webbroser.rar

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

الاخ smfsho2009 شاهد المرفق Test_1.xls

اهلا بك فى المنتدى-تفضل تم عمل المطلوب بهذا الكود Sub ØÈÇÚÉ1() Sheets("استمارة متابعة").Activate Range("H2").Activate [H2] = 1 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Do ActiveCell = ActiveCell + 1 ActiveWindow.SelectedSheets.PrintOut Loop While ActiveCell.Value <= Range("x2").Value Range("H2").Activate [H2] = 1 End Sub طباعة كل الأسماء.xlsm

جزاك الله خير اخي احمد دكتور محمد جزاك الله خير اخي الفاضل فقد كافأت واحسنت الجزاء قَالَ رَسُولُ اللَّهِ صَلَّى اللَّهُ عَلَيْهِ وَسَلَّمَ : ( مَنْ صُنِعَ إِلَيْهِ مَعْرُوفٌ فَقَالَ لِفَاعِلِهِ : جَزَاكَ اللَّهُ خَيْرًا فَقَدْ أَبْلَغَ فِي الثَّنَاءِ ) تقبل من اخيك كل الود والتقدير منكم نستفيذ استاذنا جعفر ومنكم نتعلم قبل الاكواد والحلول الجميلة نتعلم التواضع وحسن الخلق اسأل الله ان يكون ما تقدمه في ميزان اعمالك اخي @أحمد الفلاحجى اعجبني مثالك واسمح لى بتعديل بسيط ليكون التحديد والالغاء بامر واحد DoCmd.SetWarnings False If Me.NAll.Caption = "no" Then DoCmd.RunSQL "UPDATE table1 SET table1.[yesNo] = 0;" Me.Requery Me.NAll.Caption = "yes" ElseIf Me.NAll.Caption = "yes" Then DoCmd.RunSQL "UPDATE table1 SET table1.[yesNo] = -1;" Me.Requery Me.NAll.Caption = "no" DoCmd.SetWarnings True End If ولتبسيط الامر نقول اذا كان زر الامر باسم no نفذ استعلام بجعل قيمة خانة الاختيار غير محددة ثم حدث وغير اسم زرالامر الى yes واذا كان زر الامر باسم yes نفذ استعلام لتغيير قيمة خانة الاختيار الى محدد ثم حدث واعد تسمية زر الامر الى no yn.accdb

السلام عليكم تفضل اخي الكريم =DLookup("[Balance]"; "[Query1]"; "[barcode] =" & farey2!barcode) balacne on form.rar تحياتي

لا لزوم للكود ولا لليوزر في هذه الحالة شاهد هذا الملف COND_FORMAT.xlsm

جربي المرفق Test1.accdb DoCmd.SetWarnings False If [خيار12] = True Then DoCmd.RunSQL "UPDATE table1 SET table1.yesno = yes " Me.Requery Else DoCmd.RunSQL "UPDATE table1 SET table1.yesno = no " Me.Requery End If DoCmd.SetWarnings True

ربما هذا هو المطلوب fayz.rar

السلام عليكم جرب الحل في الملف المرفق... تجميع اعمدة.xlsx

طريقة استخدمها في برامجي اتمنى لكم الفائدة officna_salloum.accdb

اعد التحميل Test_1.xlsm Test_2.xlsm

بعد اذن الاخ علي نظرة على هذا الملف Max_min.xlsx

الحمدلله 🙂 وشكرا على المعلومة 🙂 جعفر

تفضل تم الحل من قبل أستاذنا الكبير حسين مأمون له منا كل المحبة والإحترام User.xlsm

عفوا ، انا لم افهم شيء !!

اعد التحميل الملف الاول تم استخدام عناصر تحكم النموذج بدلا من استخدام عناصر تحكم ActiveX الملف الثاني لم ينم الانشاء من عناصر تحكم النموذج او عناصر تحكم ActiveX بل تم انشاء الفرام والزر بأستخدام Crate Object.Controls عن طريق انشائهم بواسطة Module وبمساعدة Class كود Module1 Dim objButtons(1 To 1) As New Class1 Sub Add_Frame() With ActiveSheet.OLEObjects .Delete With .Add(ClassType:="Forms.Frame.1", Link:=False, DisplayAsIcon:=False) .Name = "Frame1" .Left = 400 .Top = 75 .Width = 200 .Height = 75 With .Object.Controls.Add("Forms.CommandButton.1", "cmdButton1", True) .Caption = "OK" .Left = 5 .Top = 5 .Width = 75 .Height = 30 End With End With End With Application.OnTime Now, "SetOnAction" ' End Sub Private Sub SetOnAction() ' Dim x As Control For Each x In ActiveSheet.OLEObjects(1).Object.Controls If TypeOf x Is MSForms.CommandButton Then i = i + 1 Set objButtons(i).CmdBtn = x End If Next On Error Resume Next If ActiveWorkbook.Sheets.Count = 1 Then Application.DisplayAlerts = False ActiveWorkbook.Sheets.Add.Delete Application.DisplayAlerts = True Else With ActiveSheet .Next.Activate .Activate End With End If ' End Sub كود Class1 Public WithEvents CmdBtn As MSForms.CommandButton Private Sub CmdBtn_Click() ' Select Case Me.CmdBtn.Caption Case "Ok" Case Else MsgBox "Hello" End Select ' End Sub مع استخدام حدث Workbook_Open لعمل اضافة الفرام والزر عند فتح الملف ولا توجد طريقة لأستخدام Frame سوي هاتين الططريقتين Private Sub Workbook_Open() ' Add_Frame ' End Sub ومن الاسهل لك لتطويع الكود الطريقة الاولي بملف Test_1 Test_1.xlsb Test_2.xlsb

بارك الله فيك أستاذ جعفر هذه هى النتيجة آخر 3 تقارير لكل موظف و هذا هو ال sql SELECT qq1.TaqEmp, qq1.taqFrom, qq1.taqTo, qq1.taq_number FROM qq1 WHERE (((qq1.taqFrom) In (SELECT TOP 3 ss.taqFrom FROM qq1 AS ss where ss.taqemp = qq1.taqemp ORDER BY ss.taqFrom DESC; ))) ORDER BY qq1.TaqEmp, qq1.taqFrom DESC;

طريقة احترافية اخي @jjafferr بارك الله فيك .... دائما نستفيد منك

أستاذ warvin raviny أين الضغط على الإعجاب ؟! 💙

وعليكم السلام تم عمل المطلوب برقم السيارة عباد الرحمن 12020.xlsm

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

اسمحوا لي ان اشرح فائدة الطريقة اللي اشرت لها انا 🙂 الفائدة هي محاكاة البرنامج الاخر ، وارسال بيانات له ، واستيراد بيانات منه ، وهذا لا يقتصر على قاعدة البيانات التي فتحت البرنامج الآخر ، وانما يعتمد على اي عدد من قواعد البيانات التي فتحتها عن طريق المتغير appAccess و appAccess2 و ... وبعد اذن اخي ابو البشر ، فاستخدمت مرفقه ، وبتعديل بسيط على البرنامج Sub بحيث النموذج mark2 لا يُفتح تلقائيا ، واضفت له زر : الكود التالي : يفتح قاعدة البيانات Sub ، 1. يرسل القيمة "c:\abc\abc" الى الحقل txtPath ، 2. ويأخذ المسمى الموجود في حقل التسمية 7 ، ويضعه في برنامجنا : Private Sub cmd_View_Kids_info_Click() On Error GoTo err_cmd_View_Kids_info_Click Dim appAccess As Object Dim DB_Path As String Dim myWhere As String 'if the Remote Application/Form is open, close it first appAccess.DoCmd.Quit 'now open the Form for the new Employee_ID Set appAccess = CreateObject("Access.Application") DB_Path = Application.CurrentProject.Path & "\mark2.mdb" appAccess.OpenCurrentDatabase (DB_Path) appAccess.DoCmd.OpenForm "Mark" appAccess.Visible = True With appAccess.Forms!Mark .txtPath = "c:\abc\abc" Me.lbl2.Caption = .[تسمية7].Caption End With appAccess.UserControl = True 'Set appAccess = Nothing Exit_cmd_View_Kids_info_Click: Exit Sub err_cmd_View_Kids_info_Click: If Err.Number = 91 Or Err.Number = 462 Then 'the application is NOT open, ignore the error Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub جعفر fayz.zip

شكرا استاذ جعفر موضوع تكثر الحاجة اليه ..

السلام عليكم تفضل اخي الكريم بالنسبة لطلبك حول جلب اسماء التقارير داخل الكومبو بوكس Report.rar

السلام عليكم 🙂 وهذا من قديم الصوف 🙂 جعفر

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

تفضل سؤال وجواب2.xlsm

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم تحياتي

من خصائص الحقل كما في الصورة :

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

استعمل TOP 3 بدلا عن TOP 1 جعفر

شكرا لك أستاذ kha9009lid وشكرا للاستاذ محمد ابوعبد الله على كل ماقمتم به أرجو أن يكون في ميزان حسناتكم test(5).accdb

جرب هذا الكود تم تغيير اسماء الشيتات الى اللغة الاجنبية لسهولة التعامل مع الكود من حيث النسخ واللصق Option Explicit Private Sub Worksheet_Activate() FIL_CDATA_VAL End Sub '++++++++++++++++++++++++++++++++++++++++++++++++ Sub FIL_CDATA_VAL() Dim i As Long: i = 8 Dim DIC As Object Set DIC = CreateObject("Scripting.Dictionary") Do Until Sheets("DATA").Range("C" & i) = vbNullString DIC(Sheets("DATA").Range("C" & i).Value) = "" i = i + 1 Loop With Sheets("RESULT").Range("k5").Validation .Delete .Add 3, Formula1:=Join(DIC.KEYS, ",") End With Set DIC = Nothing End Sub '++++++++++++++++++++++++++++++++++++++++ Sub GET_CERTIFICAT() Dim dat As Worksheet, RES As Worksheet Dim Num%, k%, R, i%, Found_Ro%, Ro%: Ro = 8 Dim FOUND_RG As Range Dim n: n = 3 Dim arr Set dat = Sheets("DATA"): Set RES = Sheets("RESULT") Union(RES.Range("c5"), RES.Range("c19"), RES.Range("c33")) = vbNullString Union(RES.Range("c8:k9"), RES.Range("c22:k23"), RES.Range("c36:k37")) = vbNullString Num = RES.Range("K5") arr = Array(2, 5, 7, 9, 11, 13, 15, 17, 19, 21) For k = 1 To n Set FOUND_RG = dat.Range("a8").CurrentRegion.Columns(3). _ Find(Num, LOOKAT:=1) If FOUND_RG Is Nothing Then Exit Sub R = FOUND_RG.Row RES.Cells(Ro - 3, 3) = dat.Cells(R, arr(0)) For i = 1 To UBound(arr) With RES.Cells(Ro, 3).Offset(, i - 1) .Value = dat.Cells(R, arr(i)) .Offset(1) = dat.Cells(R, arr(i) + 1) End With Next RES.Cells(Ro + 2, 3) = dat.Cells(R, 23) Num = Num + 1: Ro = Ro + 14 Next End Sub الملف مرفق RESULT.xlsm

تفضل >>>>> MARK.mdb

جرب هذا الملف الكود يعمل في النطاق من A1 الى A10 (اللون الأصفر) الكود Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.EnableEvents = False If Not Intersect(Target, Range("A1:A10")) Is Nothing _ And Target.Count = 1 Then Range("B1:B10").ClearContents Target.Offset(, 1) = Range("F1") End If Application.EnableEvents = True End Sub الملف مرفق Writ in Offset.xlsm

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

السلام عليكم أستاذ جعفر موضوع في قمة الروعة ملاحظة صغيرة في الكود الموضوع بالأعلى : هناك بعض المتغيرات غير مصرح بها مع أنها موجودة في المرفق لكن من يريد تطبيق الكود بشكل مباشر من المشاركة سوف يظهر له خطأ. Public Const msoBarPopup = 5 Public Const msoControlButton = 1 Public Const msoControlEdit = 2 Public Const msoControlComboBox = 4 Public Const msoButtonUp = 0 Public Const msoButtonDown = -1 أخيرا لي الشرف العظيم أن أقوم بتثبيت هذا الموضوع

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

عليك السلام ورحمة الله وبركاته بالنسبة للمطلوب الأول جرب هذا لعله يفي الغرض jour.xlsm

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

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

السلام عليكم و رحمة الله تعالى و بركاته. أستأذنك أستاذ القدير جعفر في إضافة تعديل بسيط على الكود الذي قمت بتقديمة. الكود الذي كتبته أستاذي يقوم بتحديد الخانة الغير محددة و نزع التحديد عن الخانة محددة لقد أضفت تعديل بسيط ليقوم الكود بتحديد كامل الخانات أو إزالة التحديد من جميع الخانات كما طلب السائل. Dim f As String Dim rst As DAO.Recordset Set rst = Me.RecordsetClone rst.MoveLast: rst.MoveFirst RC = rst.RecordCount f = rst!done For i = 1 To RC If f = "true" Then rst.Edit rst!done = False rst.Update Else rst.Edit rst!done = True rst.Update End If rst.MoveNext Next i rst.Close: Set rst = Nothing Selection.rar

وعليكم السلام تفضل 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 . جعفر

السبب الذي قلت ان جدولك ليس صحيحا لقاعدة البيانات ، هو انك يجب ان تضيف حقل جديد كل شهر ، فالطريقة الصحيحة لعمل الجداول هو اضافة سجلات وليس اضافة حقول وهناك مثل مشهور في قواعد البيانات يقول : الحقول غالية والسجلات رخيصة اما اذا تريد تمشي حالك الان بالجدول الموجود ، ومجرد تريد ان تجمع قيم جميع الحقول ، اعمل استعلام فيه جميع الاسماء ، وننادي منه الدالة Add_Salaries والتي عملناها في الوحدة النمطية ، ونرسل معها اسم الشخص: . وهذا كود الدالة Add_Salaries: Function Add_Salaries(F As String) As Double 'F = Full Name Dim rst As DAO.Recordset Dim fld As Field 'get this Name Record from the table Set rst = CurrentDb.OpenRecordset("Select * From [salary2015+2014] Where Full_Name='" & F & "'") T = 0 'initial Total 'loop through the fields For Each fld In rst.Fields 'Debug.Print fld.Name & vbTab & fld.Value 'skip the Full_Name field name If fld.Name <> "Full_Name" Then 'add the field values T = T + fld.Value End If Next fld 'now send this Total to the query Add_Salaries = T End Function . حيث اننا في الدالة نطلب سجل الشخص من الجدول salary2015+2014 ، ثم نقول بقراءة الحقول وجمعها ، زنرسل النتيجة الى الاستعلام ، فتصبح نتيجة الاستعلام: . جعفر 262.salary2015+2014.accdb.zip

وعليكم السلام هناك طريقة افضل لحفظ سجلاتك في الجدول ، فطريقتك مأخوذة من الاكسل مثلا ، وليست صحيحة لقواعد البيانات . عملت لك جدول جديد ، وجلبت لك البيانات اليه: . والبيانات: . وعليه ، عملت عدد 2 استعلام جدولي ، واحد شامل لكل السنوات: . ونتائجه: . واستعلام سنوي (يعني استخدم خاصية التصفية) ، لكل سنة على حدة: . والنتيجة: . جعفر 262.salary2015+2014.accdb.zip