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

وعليكم السلام 🙂 اي حقل يخبرنا عن الشهر؟ انا استعملت [تاريخ البداية] ، واذا كان غير ، فرجاء تغير الاسم هنا : . وفي هذا النموذج تختار الشهر والسنه ، ويتم التصدير لنفس مجلد البرنامج ، ويكون الملف باسم: Client_Year-Month ، مثل Client_2021-10.xlsx . وهذا كود التصدير: Dim xls_File As String xls_File = Application.CurrentProject.Path & "\Clients_" & Me.iYear & "-" & Me.iMonth & ".xlsx" DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qry_Export_to_Excel", xls_File, True جعفر 1503.تصدير.zip

حسب فهمي للمطلوب يتم تعديل الكود الأصلي إلى Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Columns(1)) Is Nothing Then Range("b" & Target.Row & ":o" & Target.Row).ClearContents End If End Sub إن شاء اللّه يكون هو المطلوب بالتوفيق

السلام عليكم ورحمة الله تعالى وبركاته يسأل البعض عن عدم حفظ البيانات الإ بإستكمال الحقول المطلوبة يمكن ذلك من خلال الفكرة الاتية ولكن بشرط اسم العنصر المطلوب ( الاجبارى) يجب وضع الرمز * فى الـ 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

تفضل هذا التعديل المحزن.zip

وعليكم السلام 🙂 استخدمت نتائج 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) جعفر

=SUMPRODUCT(0+(CELL("width",OFFSET(B2,,N(INDEX(COLUMN(B2:G2)-MIN(COLUMN(B2:G2)),,))))>0),B2:G2)

يمكنك إضافة هذا السطر If TextBox4 >= 1 And TextBox5 >= 6 Then TextBox3 = DateAdd("d", -45, TextBox3) بعد هذا السطر TextBox3 = DateAdd("m", (Val(TextBox4) * -3), TextBox2) بالتوفيق

نعم تقدر تستفيد من هذه الطريقة 🙂 قام حظك ابو جودي 🙂 جعفر

وعليكم السلام 🙂 في اعدادات الاكسس ، قم بإختيار status bar (في الدائرة الحمراء) . فلما تأتي للنموذج ، تجد ان القيمة موجودة هنا (السهم الاحمر) 🙂 . لذلك ، استخدم Tag بدلا عن Status Bar Text ، لأن الاكسس قد يستعمل هذه الخاصية ، وتختفي علامة * ويتم استبدالها بقيمة اخرى🙂 جعفر

تفضل التعديل الازرار.accdb

تفضل هذا المثال اكمالي البيانات و جربي الاتصال بجدول MyData.zip

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

لكي يتم هذا الأمر تحتاج إلى: خلية بها تاريخ النهاية وليكن A1 وخلية بها مسار المجلد وليكن B1 ثم تستعمل هذا الشرط If date >= [a1] and [b1] <> "" then your delete code [b1] = "" end if بالتوفيق

بارك الله فيك اخى الكريم تسلم ايدك

God reward you جزاك الله خيرا

جميعا بإذن الله

شكرا من أعماق قلبي شغالة بارك الله فيكم ودمتم لهذا المنتدى الطيب

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

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

بصراحة لا أدري تعمل على 2010 + =SUBTOTAL(9,B3:B7) 2007

مثال =AGGREGATE(9,5,B3:B7)

وعليكم السلام 🙂 بالاضافة الى ملاحظة اخوي حسين ، فقوانين المنتدى تتطلب ان يكون لكل سؤال موضوع خاص 🙂 جعفر

لقد قمت بإغلاق السؤال في حال تم اغلاق السؤال لن يلتفت احد بعد ذلك للموضوع انصحك بفتح موضوع جديد يتضمن السؤال او الاستفسار الذي تريده شكرا لك

الشكر لله الذي وفقنا لهذا

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

هيتعرض الساعة ٥ بتوقيت مكة المكرمة

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

تسلم ايدك كلها افكار جميلة

ودي الفكرة مشروحة بشكل اوسع علي النماذج والتقارير https://youtu.be/U89NfVq7moo

وعليكم السلام 🙂 تفضل: Private Sub Command4_Click() Call ApendData("MyTable", Me) End Sub Function ApendData(strTableName As String, frm As Form) Dim db As DAO.Database Dim rs As DAO.Recordset Dim ctl As Control Set db = CurrentDb() Set rs = db.OpenRecordset(strTableName) rs.AddNew For Each ctl In frm.Controls If ctl.ControlType <> acLabel And ctl.ControlType <> acCommandButton Then rs.Fields(ctl.Name) = ctl.Value End If Next ctl rs.Update rs.Close End Function جعفر ApendDataByRecordset.zip

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

تم تعديل الكود

المرفق رقم ( 2 ) فى المرفق الاول تحدثنا عن التشفير هذا المرفق يحتوى فقط على الجداول اللازمة لانشاء نظام الصلاحيات يختوى المرفق على - جدول UsystbllvlControlForms هذا الجدول الخاص بادراج اسماء النماذج المراد تطبيق صلاحيات الفتح والاضافة والتعديل والحذف عليها - جدول UsystbllvlGroup هذا الجدول الخاص باضافة اسماء المجموعات التى نريد عمل الصلاحيات لها - جدول UsystbllvlQuestions هذا الجدول الخاص باضافة اسئلة الأمان التى سوف يقوم المستخدم بإختيارها والإجابة عليها اثناء تقديم طلب التسجيل والتى سوف تمكنه من استعادة كلمة المرور فى حالة نسيان كلمة المرور - جدول UsystbllvlRegistrationUsers هذا الجدول الذى سوف يتم اضافة بيانات المستخدمين فيه والتى تحتاج قيما بعد لتفعيلها من قبل مسئول النظام -جدول UsystbllvlUsers جدول بيانات المستخدمين SecurityLevelGroup.mdb

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

جرب هذا التعديل Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Columns(1)) Is Nothing Then Application.EnableEvents = False Target.Offset(, 1).Resize(, 14).Delete xlShiftUp End If Application.EnableEvents = True End Sub

وعليكم السلام ورحمة الله وبركاته هذا الموضوع به طلبك ان شاء الله https://www.officena.net/ib/topic/66864-استدعاء-فورم-عن-طريق-رقم-سري/#comment-434812

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

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

The question is not logical as there are many difference in the inputs in the two columns That's my try but of course not the perfect solution Sub Test() Dim e, x, r As Range, c As Range, s As String, v As String, t As String, b As String, d As String, f As String Application.ScreenUpdating = False With ActiveSheet.UsedRange .Columns(3).Interior.Color = xlNone .Columns(14).Interior.Color = xlNone For Each c In .Columns(14).Cells If c.Value = "" Then GoTo iNext b = Replace(c.Value, Chr(218) & Chr(200) & Chr(207) & Chr(32) & Chr(199), Chr(218) & Chr(200) & Chr(207) & Chr(199)) x = Split(b) d = x(0) & Space(1) & x(1) & Space(1) & x(2) b = Replace(c.Value, Chr(236), Chr(237)) x = Split(b) f = x(0) & Space(1) & x(1) & Space(1) & x(2) x = Split(c.Value) v = x(0) & Space(1) & x(1) & Space(1) & x(2) t = Replace(v, Chr(201), Chr(229)) With .Columns(3) For Each e In Array(t, v, d, f) Set r = .Find(e, , xlValues, xlPart) If Not r Is Nothing Then s = r.Address Do r.Interior.Color = vbYellow Rem c.Interior.Color = vbRed Set r = .Find(e, , xlValues, xlPart) Loop Until r.Address = s Set r = Nothing End If Next e End With iNext: Next c End With Application.ScreenUpdating = True End Sub

لا يمكنك ذلك اطلاقا بالليست بوكس .استخدم اداة listview

هذه بعض نتائج البحث في المنتدى بالتوفيق

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته أخر نسخة من البرنامج بعد عمل عدة تعديلات 1185844841_.rar

السلام عليكم ورحمة الله وبركاته أحبائى وأساتذتى ومعلمينى فى هذا الصرح العلمى الهائل تحية طيبة وبعد أقدم لكم اليوم مجموعة رائعة من الأيقونات زات الجودة العالية أرجوا من الله أن تنال إعجابكم http://www.mediafire.com/download/42x3exq2c119cvo/1.rar http://www.mediafire.com/download/97cazvonq76t7r5/2.rar#1 http://www.mediafire.com/download/3da8dafesiy96hc/3.rar http://www.mediafire.com/download/byhgi1eu2u9ou29/4.rar http://www.mediafire.com/download/31yspi92357332b/5.rar http://www.mediafire.com/download/mydc1fc09z1kbj7/6.rar http://www.mediafire.com/download/ewm23d4geccddex/7.rar تقبلوا خالص تحياتى وتقديرى

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

الأخت الكريمة الكود الذي وضعه أخونا/اختنا jasmin صحيح ويقوم باستيراد الجدول كاملا أيضا من خلال ado ولكي تقومي باستيراد حقول معينة من الجدول يلزمك بعض الخبرة بكتابة لغة الاستعلامات SQL ولهذا أنصحك بتصميم استعلام للحقول التي تريدين استيرادها من الأكسس (في الأكسس) ثم تقومي بتصدير هذا الاستعلام إلى ملف الإكسل المطلوب أتمنى أن يكون اتضح الأمر

وتسهيلا على الإخوة من طول المعادلة قمت بعمل دالة تقوم بالغرض المطلوب بسهولة Function MasDateAdd(interval As String, number As Double, dt As Date) As Date MasDateAdd = DateAdd(interval, number, dt) End Function وطريقة استدعائها =MasDateAdd("m",14,a1) وتعني إضافة 14 شهر (m) إلى التاريخ الموجود في الخلية a1 و ينبغي علينا معرفة الحروف التي يجب كتابتها في interval وهي كالتالي yyyy ----> year , q ----> quarter , m ----> month , d ----> day , ww -----> week , w -----> weekday , y -------> day of year , h ----> hour , n ------> minute , s ---------> second أتمنى أن تكون الدالة موفقة في تأدية المطلوب ملحوظة الدالة تعمل بالزيادة والنقص بمعنى أنه يمكننا طرح عدد معين من الشهور أو الأيام من تاريخ معين مثال =MasDateAdd("m",-14,a1) ولا تنسو أخاكم محمد صالح من صالح دعائكم

أخي الكريم بعد إذن أخي طارق يمكنك استعمال هذه الدالة على فرض أن التاريخ موجود في الخلية a1 =DateAdd("m",14,a1)

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

جزاك الله كل خير شرح مفيد ومختصر

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