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

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

وعليكم السلام ورحمة الله بركاته من خلال التجربة كود استاذنا الفاضل بن عليه سريع جدا اما طول الكود فتم اختصاره بكود من المنتدى وكما يقال كل الطرق تؤدي الى روما . فكود السيد بن عليه والكود المختصر يؤديان نفس النتيجة تحياتي كشف حضور وغياب1.xlsm

وعليكم السلام 🙂 انا اختلف مع اخوي ابو جودي ، والجواب: نعم تقدر 🙂 ولكن بسبب التصميم ، فما جميع الانواع يكون عرض بياناتها تكون مقبولة 🙂 جعفر

وعليكم السلام 🙂 الطريقة التي تريدها لا تصلح !! عندك الكثير من الحالات ، مثل: نوع الحقل ، واستخدام دوال خاصة ، وووو اليك ما توصلت له ، وبتعرف قصدي من الملاحظات اعلاه: Function Do_SQL(strTableName As String, frm As Form) As String Dim ctl As Control Dim mySQL As String, mySQL_f As String, mySQL_v As String 'mySQL_f = Fields 'mySQL_v = Values ' 'filed names to reveal field Types, examples: 'str_Name > Text 'dt_Today > Date ' For Each ctl In frm.Controls If ctl.ControlType <> acLabel And ctl.ControlType <> acCommandButton Then 'fields mySQL_f = mySQL_f & ", " & ctl.Name 'values Select Case ctl.Name 'special cases Case "Uname", "UPassword", "FullName", "lvlAnsr1", "lvlAnsr", "lvlAnsr3", "Umail" mySQL_v = mySQL_v & ", Encoder('" & ctl.Value & "')" Case Else If Left(ctl.Name, 3) = "str" Then 'text mySQL_v = mySQL_v & ", '" & ctl.Value & "'" ElseIf Left(ctl.Name, 2) = "dt" Then 'Date mySQL_v = mySQL_v & ", #" & ctl.Value & "#" Else 'the normal mySQL_v = mySQL_v & ", " & ctl.Value End If End Select End If 'ctl.ControlType Next ctl 'remove the initial comma mySQL_f = Mid(mySQL_f, 2) mySQL_v = Mid(mySQL_v, 2) mySQL = "INSERT INTO " & strTableName mySQL = mySQL & " ( " & mySQL_f & " ) " mySQL = mySQL & " SELECT " mySQL = mySQL & mySQL_v Debug.Print mySQL End Function . لهذا السبب ، مشاركتي السابقة هي افضل طريقة للتعامل مع هذا النوع من الاستعلامات 🙂 جعفر

وعليكم السلام 🙂 المبتدئ: يريد ان يعمل برنامج ، ويشتغل البرنامج حسب المطلوب ، المحترف: يريد ان يعمل برنامج ، ويشتغل البرنامج حسب المطلوب ، ثم تركيزه يصب على سرعة عمل البرنامج: تجربة قاعدة البيانات على ما لا يقل عن 10,000 سجل ، عمل العلاقات بين الجداول ، عمل فهرسة الحقول في الجداول ، وذلك بفهرسة جميع الحقول التي نعمل لها فرز او تصفية ، في اي مكان في قاعدة البيانات ، عمل فهرسة لجميع المتغيرات في محرر الاكواد ، بإستخدام Dim او Private او ... لهذه المتغيرات ، وافضل طريقة لإجبار المستخدم على العمل بها ، هو إضافة السطر الثاني: Option Explicit (طبعا بالاضافة الى السطر الاول) ، استعمال الاستعلام العادي بدلا عن استعلام الكود ، الاستفادة من وجود البيانات في النموذج ، وعمل المطلوب بها ، بدل ان يطلب البيانات مرة اخرى من الجداول بأوامر مثل Dlookup واخواتها ، وذلك لتقليل الضغط على الشبكة ، عدم استعمال الاوامر Dlookup واخواتها في الاستعلام ، إلا في حالات جدا نادرة ، واكيد اني نسيت ملاحظات اخرى 🙂 فالرد على سؤالك هو النقطة 4 🙂 جعفر

السلام عليكم ورحمة الله تعالى وبركاته يسأل البعض عن عدم حفظ البيانات الإ بإستكمال الحقول المطلوبة يمكن ذلك من خلال الفكرة الاتية ولكن بشرط اسم العنصر المطلوب ( الاجبارى) يجب وضع الرمز * فى الـ Tag الخاصة به كما بالصورة الاتية لاننى وضعت الاكواد فى الموديول تعتمد عليها والان الاكواد داخل الموديول 'RequiredData Function RequiredData(ByVal frm As Form) On Error Resume Next Dim ctl As Control Dim err As Integer For Each ctl In frm.Controls Select Case ctl.ControlType Case acTextBox, acComboBox, acListBox, acCheckBox, acOptionButton, acOptionGroup: 'If ctl.StatusBarText = "*" Then If ctl.Tag = "*" Then If IsNull(ctl) Or ctl = "" Or ctl = Null Then ctl.BackColor = 15531489 ctl.SetFocus err = err + 1: MsgBox "Please fill in the " & ctl.Controls(0).Caption: Exit Function Exit For Exit Function Else ctl.BackColor = 16777215 End If End If End Select Set ctl = Nothing Next ctl End Function ويتم استدعاء الكود من خلال Call RequiredData(Me) اترككم مع الاستمتاع بالتجربـة وفى انتظار ارائكم Required data (2).mdb

فى اى وقت تريد اهلا بك لو انك تتحدث عن نموذج مستمر وتريد بكبسة زر انشاء الـ QR Code ان شاء الله تجد مرادك هنا

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

ممكن مرفق يحتوى على جدول بيانات وتحدد الحقول التى تريد لها ان تكون ضمن عمل الــ QR code

طيب ..... شغل الاستعلام رقم 1 وسوف تجد المطلوب في الجدول 2 Database32.accdb

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

انظر هل هذا ما تريد ؟؟؟؟

🙂

حسب فهمي للمطلوب يتم تنفيذ أمر الطباعة أولا ActiveSheet.PrintOut ثم سطر التصدير إلى. Pdf في نفس مسار ملف الاكسل باسم FileName.pdf الذي يمكن تغييره ActiveSheet.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "/" & "FileName.pdf", , , False بالتوفيق

حتى اذا محترف آخر يشوف الكود اللي انا عملته ، يمكن يكون عنده ملاحظه عليه ، فلا تهتم ، فاذا الكود شغال ، انتهيت من اول واهم خطوة ، والباقي تحصل عليه بالتجربة 🙂 نضع فيه هذه العبارة Option Explicit في جميع صفحات الكود ، ولكن ، ضعه في صفخة ، ثم Debug < Compile ، فتظهر لك المتغيرات التي تحتاج الى عمل Dim لها ، وتنتقل للصفحة التالية ، وهكذا . جعفر

السلام عليكم بعد ادن الاستاد ابو عيد طريقة اخرى قريبة من طلبك ب VBA اتمنى ان يفيدك Option Explicit Sub test1() Dim lr Dim x, r Dim dt1, dt2 dt1 = CDate(Range("b4")) dt2 = CDate(Range("b5")) If dt1 = 0 Then MsgBox "ادخل التاريخ من", vbInformation: Exit Sub If dt2 = 0 Then MsgBox "ادخل التاريخ الى", vbInformation: Exit Sub r = 9 Range("f9:h1000").ClearContents lr = Cells(Rows.Count, 1).End(3).Row For x = 9 To lr Select Case Cells(x, 2).Value2: Case dt1 To dt2 Cells(x, 1).Resize(, 3).Copy Range("f" & r) r = r + 1 End Select Next x End Sub دالة if.xlsm

اليك هذا الموضوع البسيط ، وبدون ان ترى المشاركات ، حل السؤال على ورقة ، سطر بسطر ، واكتب النتائج ، والآن ، ترجم نفس الخطوات الى اسطر برنامج ، اكتب سطر ، وشوف النتيجة ، ثم اكتب السطر التالي ، وشوف النتيجة ، وهكذا تضيف اسطر الكود 🙂 وبعد ان يعمل برنامجك نوعا ما ، تقدر تستفيد من المشاركات ، وطبعا مو لازم كودك يكون مثل المشاركات ، هناك الف طريقة للبرمجة 🙂 المبرمج مثل الطباخ ، عنده طرق واساليب لاستعمال نفس المكونات ، واعطاء طبخات مختلفه لها 🙂 بس يعني اذا تعلمت تطبخ بيض عيون ، تسمي نفسك طباخ ، وتكون عارف كل الطبخ ، لا طبعا !! رحلة الالف ميل تبدأ بطبق بيض العيون 🙂 جعفر

شكرا شكرا الله يعافيك ... هذا هو المطلوب وشكرا لكم جميعا الله ينفع بكم

اتفضلى يا استاذه progressbar.accdb

بارك الله في الأستاذ @jjafferr والأستاذ @ابا جودى

ممكن عمل ذلك من خلال الكود التالي Private Sub Form_Timer() Me.txtcount = Me.txtcount + 1 Me.box3.Width = Me.txtcount * 20 Me.text4 = Me.txtcount & "%" If Me.txtcount = 100 Then Me.TimerInterval = 0 Me.box3.Visible = False Me.text4.Visible = False Me.txtcount.Visible = False 'DoCmd.Close End If عسى ان يكون هو المطلوب.

وعليكم السلام هل المقصود حين الانتهاء من العد لغاية 100 يتم إغلاق النموذج؟ لاني لاحظت في الماكرو وجود امر اغلاق للنموذج. اليك التعديل حسب ما فهمت. progressbar.accdb

احسنتم كثيرا كيلا الطريقتان نجحتا

وعليكم السلام 🙂 استخدمت نتائج Debug.print في الكود تبعك ، ثم حولته الى استعلام (اتضح انه استعلام الحاقي) ، حتى ابدأ من هنا 🙂 طريقتي: اعمل الاستعلام بالطريقة المعتادة: . هذه المسمات لا قيمة ولا فائدة منها ، ويمكننا ان نحذفها ، لأن الاكسس بيعطينا اسم جديد لأي حقل مافيه اسم : . جميع الحقول في الاستعلام تحتاج الى قيمة ، فيجب ان تكون جميع هذه القيم متغيرات ، وعددها 12 حقل ، بالاضافة الى اسم الجدول ، ولتبسيط هذه العملية ، سأستخدم اسم الحقل المراد الاضافة اليه بالاضافة الى الرقم 9 ، مثل: IDUser9 ، IDGroup9 ، بتحويل الاستعلام الاصل الى SQL ، نحصل على هذه الجملة: INSERT INTO UsystbllvlUsers( IDUser,IDGroup,UName,UPassword,FullName,lvlQ1 ,lvlAnsr1,lvlQ2 ,lvlAnsr2,lvlQ3 ,lvlAnsr3,Umail ) SELECT 1 AS IDUser, 3 AS IDGroup, Encoder("admin") AS UName, Encoder("admin") AS UPassword, Encoder("admin") AS FullName, 20 AS lvlQ1, Encoder("administrator") AS lvlAnsr1, 20 AS lvlQ2, Encoder("admin") AS lvlAnsr2, 20 AS lvlQ3, Encoder("managaer") AS lvlAnsr3, Encoder("admin@admin.com") AS Umail; ومن هنا سأبدأ عملية التغيير الى كود ، والهدف بعد الدقة ، هو سهولة الوصول الى الحقول المتشابهة ، اي الحقل والحقل الذي ستاتي منه البيانات ، 1. تفكيك جزئي الجملة ، الجزء الى والجزء من ، وتحويل جميع علامات " الى ' في الجملة (ما عدا التي يجب ان تبقى) : mySQL = "INSERT INTO UsystbllvlUsers( IDUser,IDGroup,UName,UPassword,FullName,lvlQ1 ,lvlAnsr1,lvlQ2 ,lvlAnsr2,lvlQ3 ,lvlAnsr3,Umail )" mySQL = mySQL & " SELECT 1 AS IDUser, 3 AS IDGroup, Encoder('admin') AS UName, Encoder('admin') AS UPassword, Encoder('admin') AS FullName, 20 AS lvlQ1, Encoder('administrator') AS lvlAnsr1, 20 AS lvlQ2, Encoder('admin') AS lvlAnsr2, 20 AS lvlQ3, Encoder('managaer') AS lvlAnsr3, Encoder('admin@admin.com') AS Umail" 2. تفكيك كل جزء الى اسم الجدول ، ثم السطر الثاني يكون اسماء الحقول ، ولنسمي هذه الاسطر 1، 2، 3، 4 mySQL = "INSERT INTO " & UsystbllvlUsers mySQL = mySQL & " ( IDUser,IDGroup,UName,UPassword,FullName,lvlQ1 ,lvlAnsr1,lvlQ2 ,lvlAnsr2,lvlQ3 ,lvlAnsr3,Umail )" mySQL = mySQL & " SELECT " mySQL = mySQL & " 1 AS IDUser, 3 AS IDGroup, Encoder('admin') AS UName, Encoder('admin') AS UPassword, Encoder('admin') AS FullName, 20 AS lvlQ1, Encoder('administrator') AS lvlAnsr1, 20 AS lvlQ2, Encoder('admin') AS lvlAnsr2, 20 AS lvlQ3, Encoder('managaer') AS lvlAnsr3, Encoder('admin@admin.com') AS Umail" ثم ندرج السطر الثاني والرابع تحت بعض (مؤقتا) ، حتى لا نخطأ ، ويكون الحقل من والى تحت بعض (لاحظ الفاصلة بين الحقول) : وعليه ، يصبح السطرين mySQL = mySQL & " ( IDUser, IDGroup, UName, UPassword, FullName, lvlQ1, lvlAnsr1, lvlQ2 , lvlAnsr2, lvlQ3 , lvlAnsr3,Umail )" mySQL = mySQL & " IDUser9, IDGroup9, Encoder('" & UName9 & "'), Encoder('" & UPassword9 & "'), Encoder('" & FullName9 & "'), lvlQ19, Encoder('lvlAnsr19'), lvlQ29, Encoder('lvlAnsr9'), lvlQ39, Encoder('lvlAnsr39'), Encoder('Umail9')" ثم نقوم بتغيير السطر حتى يأخذ المتغيرات (بدلا من مجرد وجودها في السطر الثاني) ، وهنا العمل الفعلي : الآن تم تعديل الكود لكي يستعمل المتغيرات ، ويمكنك استعماله بهذه الطريقة : mySQL = "INSERT INTO " & UsystbllvlUsers mySQL = mySQL & " ( IDUser, IDGroup, UName, UPassword, FullName, lvlQ1, lvlAnsr1, lvlQ2, lvlAnsr2, lvlQ3, lvlAnsr3,Umail )" mySQL = mySQL & " SELECT " mySQL = mySQL & IDUser9 & ", " & IDGroup9 & ", Encoder('" & UName9 & "'), Encoder('" & UPassword9 & "'), Encoder('" & FullName9 & "')," & lvlQ19 & ", Encoder('" & lvlAnsr19 & "'), " & lvlQ29 & ", Encoder('" & lvlAnsr9 & "'), " & lvlQ39 & ", Encoder('" & lvlAnsr39 & "'), Encoder('" & Umail9 & "')" فيصبح الكود النهائي بالشكل الذي انت تريده ، ولاحظ اهمية كتابة رقم الحقل بحيث الجزء الآخر يأخذ نفس الرقم ، فيسهل عليك معرفة كل جزء من الكود : Function Run_SQL(UsystbllvlUsers9, IDUser9, IDGroup9, UName9, UPassword9, FullName9, lvlQ19, lvlAnsr19, lvlQ29, lvlAnsr29, lvlQ39, lvlAnsr39, Umail9) Dim mySQL As String mySQL = "INSERT INTO " & UsystbllvlUsers9 mySQL = mySQL & "( IDUser," '1 mySQL = mySQL & "IDGroup," '2 mySQL = mySQL & "UName," '3 mySQL = mySQL & "UPassword," '4 mySQL = mySQL & "FullName," '5 mySQL = mySQL & "lvlQ1 ," '6 mySQL = mySQL & "lvlAnsr1," '7 mySQL = mySQL & "lvlQ2 ," '8 mySQL = mySQL & "lvlAnsr2," '9 mySQL = mySQL & "lvlQ3 ," '10 mySQL = mySQL & "lvlAnsr3," '11 mySQL = mySQL & "Umail )" '12 mySQL = mySQL & " SELECT " mySQL = mySQL & IDUser9 & ", " '1 mySQL = mySQL & IDGroup9 & ", " '2 mySQL = mySQL & " Encoder('" & UName9 & "'), " '3 mySQL = mySQL & " Encoder('" & UPassword9 & "'), " '4 mySQL = mySQL & " Encoder('" & FullName9 & "'), " '5 mySQL = mySQL & lvlQ19 & ", " '6 Questions '6 mySQL = mySQL & " Encoder('" & lvlAnsr19 & "'), " '7 mySQL = mySQL & lvlQ29 & ", " '6 Questions '8 mySQL = mySQL & " Encoder('" & lvlAnsr29 & "'), " '9 mySQL = mySQL & lvlQ39 & ", " '6 Questions '10 mySQL = mySQL & " Encoder('" & lvlAnsr39 & "'), " '11 mySQL = mySQL & " Encoder('" & Umail9 & "') " '12 'Debug.Print mySQL DoCmd.SetWarnings False DoCmd.RunSQL mySQL DoCmd.SetWarnings True End Function . وتناديه بإرسال قيم هذه المتغيرات : Call Run_SQL(tbl_Name,IDUser, IDGroup, UName, UPassword, FullName, lvlQ1, lvlAnsr1, lvlQ2, lvlAnsr2, lvlQ3, lvlAnsr3, Umail) جعفر

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

وهذه مشاركتي مع اخوي ابوجودي 🙂 استعمل النموذج frm_Generate_Weeks . وهكذا اصبح الكود: Private Sub cmd_Calc_Click() 'all weeks of the year 'Week Number, Saturday, Thursday 'do we have a Year If Len(Me.iYear & "") = 0 Then MsgBox "رجاء ادخال السنه التي تريد العمل عليها" Me.iYear.SetFocus Exit Sub End If 'Do we have iYear data in the table? If DCount("*", "semaine", "Year([dates1])=" & Me.iYear) Then MsgBox "الجدول به بيانات سنة " & Me.iYear & vbCrLf & vbCrLf & _ "لا يمكن الاستمرار" Exit Sub End If Dim D As Date, Date_1 As Date, Date_2 As Date Dim i As Integer, W As Integer Dim rst As DAO.Recordset Set rst = CurrentDb.OpenRecordset("Select * From semaine") For i = 0 To 366 D = DateAdd("d", i, "1-1-" & Me.iYear) If D >= "31-12-" & Me.iYear Then Exit For If Weekday(D) = 7 Then Date_1 = D 'Saturday Date_2 = DateAdd("d", 5, Date_1) 'Thursday W = W + 1 rst.AddNew rst!n_semaine = W rst!dates1 = Date_1 rst!dates2 = Date_2 rst.Update 'Debug.Print W & vbTab & Date_1 & vbTab & Date_2 End If Next i MsgBox "Done" End Sub جعفر Week, Saturday, Thursday of the year.zip

اتفضل يا سيدى ex.accdb

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

تفضل اخي الكريم Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer Dim dbs As Object Dim prp As Variant Const conPropNotFoundError = 3270 Set dbs = CurrentDb On Error GoTo Change_Err dbs.Properties(strPropName) = varPropValue ChangeProperty = True Change_Bye: Exit Function Change_Err: If Err = conPropNotFoundError Then ' Property not found. Set prp = dbs.CreateProperty(strPropName, _ varPropType, varPropValue) dbs.Properties.Append prp Resume Next Else ' Unknown error. ChangeProperty = False Resume Change_Bye End If End Function Lock shift.rar تحياتي