نجوم المشاركات
Popular Content
Showing content with the highest reputation on 13 فبر, 2022 in all areas
-
Sub Test() Dim Last As Long, i As Long Last = Sheet4.Range("A100000").End(xlUp).Row + 1 For i = 1 To 7 Sheet4.Cells(Last, i).Value = Me.Controls("TextBox" & i + 1).Value Next i End Sub3 points
-
السلام عليكم 🙂 هذا الاستعلام ، ينادي الدالة Add_Ev ونرسل لها قيم التقييم بالتسلسل (بسبب ان اسماء حقولك باللغة العربية ، للأسف نرى ان اسماء الحقول متلخبطة ، بينما ارسلت الحقول بالتسلسل) . وهذه هي الدالة تقوم بعمل القيم تحت بعضها البعض: Function Add_Ev(E1, E2, E3, E4, E5) As String Dim LineBreaker As String LineBreaker = Chr(13) '1 If Len(E1 & "") <> 0 Then Add_Ev = E1 End If '2 If Len(E2 & "") <> 0 Then Add_Ev = Add_Ev & Chr(13) & E2 End If '3 If Len(E3 & "") <> 0 Then Add_Ev = Add_Ev & Chr(13) & E3 End If '4 If Len(E4 & "") <> 0 Then Add_Ev = Add_Ev & Chr(13) & E4 End If '5 If Len(E5 & "") <> 0 Then Add_Ev = Add_Ev & Chr(13) & E5 End If End Function . التقرير 2 يظهر بهذه الطريقة ، وبدون اي اكواد في التقرير ، وهذا ما اقترحته عليك سابقا . اما التقرير التالي ، فالخطوط بين القييمات تأتي من الكود . وهذا هو الكود : Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer) Dim i As Integer Dim x() As String Dim L As Single, T As Single, W As Single, H As Single L = Me.Ev.Left T = Me.Ev.Top W = Me.Ev.Width H = Me.Ev.Height x = Split(Me.Ev, Chr(13)) For i = 1 To UBound(x) T = T + H Me.Line (L, T)-(W, T), vbBlack Next i End Sub جعفر 1468.Lines in Report.accdb.zip3 points
-
السلام عليكم .. الاساتذة الكرام الموضوع اليوم عن تتبع التغييرات التى تقوم بها على اى سجل موجود فى قاعدة البيانات .. لنبدأ لنفترض ان لدى مجموعة من النماذج التى تقوم بتعديل بيانات معينة فى الجداول واريد ان اتتبع التغييرات التى تمت بحيث يتم تسجيل البيانات قبل التعديل وبعد التعديل مثال : لدى هذا النموذج ومهمته التعديل على رصيد المخزن .. انظر للقيمة قبل التعديل : قمت بالتعديل وضغطت على زر الأمر .. النتيجة .. فى جدول التعديلات TblAudit تم تسجيل التالى : القيمة قبل التعديل وبعد التعديل .. والشخص القائم بالتعديل .. وتاريخ ووقت التعديل .. و النموذج المستخدم فى التعديل .. ومصدر بيانات هذا النموذج . فلنجرب تعديل اكثير من حقل فى النموذج دفعة واحدة : النتيجة : تابع معى لتعرف الطريقة : مبدأياً لم اكتب الكود ولكن قمت بالتعديل عليه وعملت امثلة مصمم الكود كتبت اسمها فى الكود نفسه .. افتح موديول جديد والصق هذا الكود : Public Function WriteAudit(frm As Form, lngID As Long) As Boolean On Error GoTo err_WriteAudit Dim ctlC As Control Dim strSQL As String Dim bOK As Boolean bOK = False DoCmd.SetWarnings False ' For each control. For Each ctlC In frm.Controls If TypeOf ctlC Is TextBox Or TypeOf ctlC Is ComboBox Then If ctlC.Value <> ctlC.OldValue Or IsNull(ctlC.OldValue) Then If Not IsNull(ctlC.Value) Then strSQL = "INSERT INTO tblAudit ( ID, FieldChanged, FieldChangedFrom, FieldChangedTo, User, DateofHit, FrmName , FrmRcrdSrc ) " & _ " SELECT " & lngID & " , " & _ "'" & ctlC.Name & "', " & _ "'" & ctlC.OldValue & "', " & _ "'" & ctlC.Value & "', " & _ "'" & GetUserName_TSB & "', " & _ "'" & Now & "' , " & _ "'" & M & "', " & _ "'" & R & "'" 'Debug.Print strSQL DoCmd.RunSQL strSQL End If End If End If Next ctlC WriteAudit = bOK exit_WriteAudit: DoCmd.SetWarnings True Exit Function err_WriteAudit: MsgBox Err.Description Resume exit_WriteAudit End Function اذا اردت ان تنادى هذا الكود يتم بهذه الطريقة WriteAudit(Form Name, Record ID) مثلا كالتالى فى زر امر : On Error GoTo Err_cmdClose_Click If Not IsNull(Me!ID) Then M = Me.Name ' Debug.Print M R = Me.RecordSource ' Debug.Print R X = WriteAudit(Me, Me!ID) End If DoCmd.Close Exit_cmdClose_Click: Exit Sub Err_cmdClose_Click: MsgBox Err.Description Resume Exit_cmdClose_Click ملاحظة : - يمكن استخدام الكود فى اى نموذج يقوم بتعديل البيانات وسيقوم الكود بتسجيل التعديلات وبياناتها كما اشرت سابقاً. قام استاذنا جعفر @jjafferr بعمل موضوع رائع مشابه فى الفكرة ولكن يقوم بتسجيل التعديلات التى تتم على الجداول عن طريق الماكرو يمكنك مشاهدته من هنا : مرفق مثال به نموذجين وتم استخدام نفس الاكواد فيهما .. دمتم بود Dynamic Audit Trail - Amr Ashraf.accdb2 points
-
2 points
-
كدا تم تسريب الامتحان وهذا استنتاجي للأمر بعد هذه الاشارة منكم تم وضع ليبل خلف الكمبوبوكس وبه العنوان بالتنسيق المشار اليه وفقط اليس كذلك2 points
-
2 points
-
السلام عليكم ورحمة الله وبركاته وبعد إذن أخي الكريم @lionheart إثراء للموضوع ،يمكن القيام بذلك عن طريق التنسيق الشرطي كما يلي: علماً أن نتيجة الكود الذي سطرته رائعاً أخي الكريم بارك الله بكم. عذراً لأن الأخ السائل طلب كود لإيجاد النتيجة لكن يمكنه فعلا ذلك دون كود والله أعلم =AND(MOD(ROW();1)=0;$A1="")2 points
-
2 points
-
Sub Test() Dim c As Range, rFirst As Range Application.ScreenUpdating = False With ActiveSheet .Columns("A:H").Borders.Value = 0 Set c = .Columns(1).Find(.Range("A2").Value) If rFirst Is Nothing Then Set rFirst = c Do While Not c Is Nothing c.CurrentRegion.Borders.Value = 1 Set c = .Columns(1).FindNext(After:=c) If c.Address = rFirst.Address Then Exit Do Loop Range("A1:H1").Borders.Value = 0 End With Application.ScreenUpdating = True End Sub2 points
-
1 point
-
المشكلة طلعت في الكود دا DoCmd.GoToRecord , , acNewRec حاطه في حدث عند التحميل اول ما احذفه الامور تكون تمام ولما اخليه ترجع المشكلة تاني ان شاء الله تتوصل ليها ممكن نحط نفس الكود في حدث بعد تحديث للسجل في النموذج الفرعي وحضرتك اكيد عندك فكر احسن مني1 point
-
عملتها زي ما حضرتك قلت ونجحت ... فكرة جميلة بس غير عملية .. لانك لازم تعمل نص فارغ وتعمل التأشير عليه شكرا استاذ عمر .. نحتاج من حضرتك تعملنا كوزات (QUIZ) 😍1 point
-
يبقى من المناقشات يا اخوان استنتجنا ان هناك طريقتين بدون اكواد لعمل المطلوب : الطريقة الاولى كما قال الاستاذ @ناقل والاستاذ موسى على خطوتين الخطوة الاولى كتابة العنوان فى حقل التنسيق فى خصائص الكومبوبوكس Format كالتالى @;"العنوان المطلوب" والخطوة الثانية تنسيق شرطى للكومبوبوكس فى حالة الفراغ كالتالى Expression Is IsNull([Combo])=True واختر التنسيق المطلوب . ملاحظات على الطريقة : تنسيق العنوان سيكون مثل تنسيق القائمة من حيث حجم الخط و المحازاة و مائل او عريض Bold . لن يمكنك تحديد تنسيق مختلف للعنوان فى هذه الحالة . الطريقة الثانية : طريقة العباقرة كما كشفها الاستاذ @أبو عبدالله الحلوانى عمل ليبل على القائمة وتحديد موقعه Bring To Front او جلب للأمام وممكن نزود حتة كود صغير After Update كالتالى 😄 If Not IsNull(Me.Combo0) Then Me.Label2.Visible = False Else Me.Label2.Visible = True End If طبعا خاصية Bring to Front او Send to Back لا يتم استخدامها الا فى وضع التصميم Design View وبالتالى سنستعين بخاصية الاظهار للعناصر للتحكم فى وقت ظهور واختفاء الليبل ولتكون النتيجة كما فى اول الموضوع . المزايا فى هذه الطريقة ان يمكنك تحديد تنسيق مختلف للعنوان من حيث حجم الخط او المحازاة او نوع الخط وهكذا . سامحونى على الطريقة من باب التسلية والنقاش بين الاخوة مرفق مثال به الطريقتين دمتم بخير Combo box Title.accdb1 point
-
لما سحبت النموذج اللي فيه المشكلة في قاعدة بيانات تاني فارغة وحذفت كل الاكواد اللي فيه اشتغل بدون مشكلة كدة تقريبا في بعض الاكواد متعارضة معاه هشوف كدة ان شاء الله وشكرا جدا علي المعلومة دي1 point
-
نعم يستطيع واكثر مما تتخيل بكثير ان شاء الله ساحاول الاطلاع علي مرفق حضرتك لعلي استطيع مساعدتك ان شاء الله1 point
-
اشكرك كثيرا لقد اوضحت لى المشكله وارتني اين اخطأت بارك الله فيك1 point
-
1 point
-
1 point
-
ده اختبار ولى ايه .... طيب هناك طرق طبعا منها ... وضع هذا في تنسيق الكمبوبكس .... @;"رقم الموظف"1 point
-
1 point
-
شكراً وبارك الله فيك . جعله الله في ميزان حسناتك . وزادك علماً ومعرفة .1 point
-
1 point
-
السلام عليكم اخي الحبيب ابو الحسن للاسف البرنامج لا يعمل عندي بصورة جيدة فقط استطيع التعامل مع الجداول1 point
-
وعليكم السلام 🙂 اخي محمد ، ضع عملك في البرنامج او هنا ، حتى نخبرك اين الخطأ ، فهذه الطريقة افضل للتعلم من مجرد حصولك على جواب 🙂 جعفر1 point
-
برنامج رائع ومفيد ..عاشت الايادي استاذ @Amr Ashraf اقتراحي ان يتم التعديل عليه بان ياخذ GetUserName من جدول ال Users1 point
-
وعليكم السلام 🙂 اللي فهمته من كلامك ، انه اذا احد الاحداثيات ما موجودة ، فما مفروض يعطينا رابط : Hyperlink only =IIf(IsNull([N]) Or IsNull([E]),"","#https://www.google.com/maps/place/" & [N] & " " & [E]) Hyperlink Area =IIf(IsNull([N]) Or IsNull([E]),"",[Area] & "#https://www.google.com/maps/place/" & [N] & " " & [E]) جعفر1 point
-
الى الاستاذ @jjafferr إلى منارة العلم والمعرفة، اشكرك شكراً جزيلاً بعدد ألوان الزهور وقطرات الندى على مجهوداتك الكبيرة التي لا تتوقف لأجل تحقيق التميز والتقدم. بارك الله فيك وجعلها في ميزان حسناتك الله يوفقك وينير لك طريقك يارب العالمين. هل الوحدة النمطية mod_Draw_Box_Lines احذفها لان ليس لها دور ام لا ؟؟؟1 point
-
1 point
-
صديقي @محمد حسن المحمد معادلتك جيده في حاله انها تستخدم مره واحده لنفس الصفحه ولكن الكود يتسخدم كلما تم اضافه جدول علي نفس الصفحه بضغطه بسيطه علي زرار الماكرو1 point
-
أشكرك جزيل الشكر وأعتذر مرة أخرى لك وأحترم علمك الغزير ما شاء الله بارك الله تقبل تحياتي العطرة والسلام عليكم1 point
-
Great my bro but the borders are not accurate as for using the conditional formatting. But I like your way of thinking1 point
-
انا جربت اعيد التفعيل من جديد واعتقد ان المشكله اتحلت ولسه الموضوع تحت التجربه هفضل اجرب اليوم واشوف اذا لم يظهر معي تعليق يكون هذا السبب ان شاء الله1 point
-
This is a better version If the record doesn't exist in the two tables the record will be colored with yellow and if there are two records with the same id vbCyan will be the color for different information if exists Sub Test() Const sRow As Integer = 4, eRow As Integer = 18 Dim x, y, r As Long, c As Long Application.ScreenUpdating = False With ActiveSheet .Range("B4").CurrentRegion.Sort Key1:=.Range("B4"), Order1:=xlAscending, Header:=xlNo .Range("N4").CurrentRegion.Sort Key1:=.Range("N4"), Order1:=xlAscending, Header:=xlNo .Rows(sRow & ":" & eRow).Interior.Color = xlNone For r = sRow To eRow x = Application.Match(.Cells(r, 2).Value, .Columns(14), 0) If Not IsError(x) Then For c = 2 To 12 If .Cells(r, c).Value <> .Cells(x, c + 12).Value Then If .Cells(r, c).Interior.Color <> vbYellow Then .Cells(r, c).Interior.Color = vbCyan If .Cells(x, c + 12).Interior.Color <> vbYellow Then .Cells(x, c + 12).Interior.Color = vbCyan End If Next c Else .Cells(r, 2).Resize(, 11).Interior.Color = vbYellow End If y = Application.Match(.Cells(r, 14).Value, .Columns(2), 0) If Not IsError(y) Then For c = 2 To 12 If .Cells(y, c).Value <> .Cells(r, c + 12).Value Then If .Cells(y, c).Interior.Color <> vbYellow Then .Cells(y, c).Interior.Color = vbCyan If .Cells(r, c + 12).Interior.Color <> vbYellow Then .Cells(r, c + 12).Interior.Color = vbCyan End If Next c Else .Cells(r, 14).Resize(, 11).Interior.Color = vbYellow End If Next r End With Application.ScreenUpdating = True End Sub1 point
-
Not so clear but try this code Sub Test() Const sRow As Integer = 4, eRow As Integer = 18 Dim r As Long, c As Long Application.ScreenUpdating = False With ActiveSheet .Range("B4").CurrentRegion.Sort Key1:=.Range("B4"), Order1:=xlAscending, Header:=xlNo .Range("N4").CurrentRegion.Sort Key1:=.Range("N4"), Order1:=xlAscending, Header:=xlNo .Rows(sRow & ":" & eRow).Interior.Color = xlNone For r = sRow To eRow For c = 2 To 12 If .Cells(r, c).Value <> .Cells(r, c + 12).Value Then .Cells(r, c).Interior.Color = vbCyan .Cells(r, c + 12).Interior.Color = vbCyan End If Next c Next r End With Application.ScreenUpdating = True End Sub1 point
-
السلام عليكم ورحمة الله وبركاته الحقيقة وحسبما فهمت منك ليست أقساط متأخرة بمعنى أن صاحبها تأخر في السداد بل هي أقساط متبقية لم يحن أوانها بعد وعلى هذا الأساس تكون المعادلة المطلوبة كما يلي في الخلية I19 واسحب نزولاً: =IF(h2g(D19)>TODAY();$C$14/$C$5;"") والسلام عليكم.1 point
-
السلام عليكم .. حاولت اساعد مع الاساتذة ولكن المرفق به مشكلة على جهازى كل ما احاول ادخل وضع التصميم الاكسس يتوقف عن العمل .. لى اقتراح طالما مش بتختار نوع الحساب ومحتاجه يتكتب فيه القيمة تلقائى يبقى حول الكومبوبوكس الى حقل نصى مثلا ونضع كود فى كومبوبوكس الحساب بعد التحديث اذا كان الحساب صرف يبقى نوع الحساب حديث اما اذا كان كذا يبقى نوع الحساب كذا جملة Select Case بسيطة تحل الموضوع .. على حسب فهمى لطلبك . وطلبنا منك تبسيط المرفق للتسهيل على من يجيبك ولكنك لم تستجيب 😌.1 point
-
The code is already there in ThisWorkbook module Private Sub Workbook_Open() Application.Visible = False frm_Inventory_Management.Show End Sub1 point
-
المشكلة من التقعيل الغير قانونى استخدم اداة تفعيل اخرى غير المستخدمة حاليا وبعد التفعيل قم بعمل تحديث اونلاين للاوفيس1 point
-
مرورك كريم استاذ حبيبى استاذ حسام فكرة ممتازة استاذى الحبيب بارك الله فيك اخى طيب ممتاز استاذى الحبيب كده اختار الحساب واختار بجواره نوعه تمام كيف بقى اربط هذا ب فورم الادخال فى برنامج الدائن والمدين بحيث عند اختيار الحساب فى ادخال قيد جديد يظهر اوتوماتيك نوعه اشكر اخى الكريم استاذى حبيبى دكتور حسين حبيبى الكريم الذى لا اكف عن الدعاء له والله لم اجد التعديل حيث اننى اخترت الحساب صرف ولم يظهر اى شى فى نوع الحساب معلش استاذى حبيبى اتمنى ان يتم التعديل على المرفق لانه به اخر تعديل من قبل حضرتك للسنة المالية والاكسيل والمسمى بعد تعديل السنة المالية من قبل د حسين الدائن والمدين معلش سامحنى استاذى حبيبى زادك الله من كرمه وفضله وعلمه اللهم امين يارب بعد تعديل السنة المالية من قبل الدكتور حسين الدائن و المدين.zip1 point
-
1 point
-
السلام عليكم ورحمة اللة تعالى وبركاته تم طرح الموضوع مسبقا >>----> هنا ولكن بدأ باستفسار من الاستاذ @أبو أحمد عن مجرد ادراج ملفات الصوت للاستماع اليها ثم تطرق بعد ذلك لسؤال عن شكل التصميم وطلب بعض التعديلات ولأهمية العمل من وجهة نظرى المتواضعة لكل من يريد استخدامه فى تعليم اخواننا ممن ابتلاهم الله بفقد البصر اولا اسال الله تعالى ان ينير بصيرتهم وايانا وكل امة محمد صل الله عليه وسلم ثانيا اسأل الله تعالى ان يتقبل هذا العمل المتواضع فيكتب بعد مماتى فى موازين اعمالى باب علم ينتفع منه وأخيرا المرفق الاصدار الثانى لا يعتمد على كائن مديا بلاير ولا على المكتبات التى تخصة لمن يواجه مشكلة مع الاصدار الاول ... وهو ما انصح به Braille.zip Braille V.0.2.zip1 point
-
أهلا بك @أبو عبدالله الحلوانى نعم ممكن.. لكن في مثالك لن تكون القيمة ثابتة! بل مجرد تحديث الصفحة سوف يرجع إلى وضعه الطبيعي، لكون الحقول غير مرتبطة بجدول بيانات.. الشفرة كالتالي -- نقوم بتحديد صفوف الجدول أولا لأن لنا معها أمران: الأول القيمة المطابقة للبحث وهي في الحقل الثاني من الصف، وللوقوف على الحقل المطابق يلزمنا عمل دوارة فحص.. الثاني إذا تطابقت البيانات نحدد الحقل الذي به صندوق الاختيار ومن ثم نعطيه القيمة True Sub IsChecked() Dim I As Integer Dim tr As Object Set tr = WD.querySelectorAll("table tr") For I = 1 To tr.length - 1 '-- check if second cell in the row matched textbox value If tr(I).childNodes(1).innerText = Me.Text0 Then '-- if true: in fifth cell in the row set checked property true tr(I).childNodes(4).childNodes(0).Checked = True End If Next End Sub TestCheckBoxOnHtml.zip1 point
-
ابشروا تبقى قليل للدورة لعمل تطبيق مربوط بالاكسس وعرض التقارير والمعلومات الاساسية به .1 point
-
بعض أسئلة الاستبيانات تكون ايجابية و الاخرى سلبية ، و فى حال رغبت فى اخذ متوسطات لاجابات محور معين يضم اسئلة سلبية و ايجابية ، يجب عكس النتائج الرقمية المناظرة لقيمة الرد، فمثلا الاصل فى حالة مقياس ليكارد الخماس أن تكون اجابة اتفق جدا = 5 و اتفق = 4 ، .... و هكذا ، فاذا كانت الاسئلة كلها ايجابية و هناك سؤال سلبي فهنا يجب تعديل القيم لاجابات هذا السؤال لتكون اتفق جدا = 1 ، اتفق = 2 ، ... قبل اجراء اية عمليات حسابية على المحور مثل حساب المتوسط مثلا. و اذا كان التفريغ يدويا فيمكن مراعاة ذلك ، اما فى حالة استخدام ادوات الكترونية لجمع الاستبيان فان الارقام تكون مسجلة بالفعل و يجب تعديلها ، و قد تكون العملية مرهقة فى حالة تعدد المتغيرات او كبر حجم العينة. و بالطبع يمكن تعديل الاسئلة لتكون فى نفس المحور ايجابية او سلبية ، و لكن فى بعض الاحيان يكون من الاسهل على مجيب الاستبيان الاجابة عن الصيغة الايجابية او السلبية بحسب المتعارف عليه في بعض مجالات التخصص ، فبصرف النظر عن صحة وجود اسئلة سلبية و ايجابية فى نفس المحور ، للقيام بعملية تعديل (عكس) نتائج عدد من الاجابات لتحويلها من ايجابية الي سلبية بصورة الية ، قمت باعداد دالة فى الاكسيل لتقوم بهذا الغرض (مرفق المثال). لنفرض ان الاجابات الاصلية كانت عن درجة الاتفاق مع كون وقت المشروع مناسب ، و اردتا تغيير الاجابات لتعبر عن كون زمن المشروع غير مناسب كما هو مبين: و ذلك عن طريق استخدام الدالة التالية: Function Reverse_Ordinal2(original_Ordinal As Byte) Dim newVal As Byte Select Case original_Ordinal Case Is = 1 newVal = 5 Case Is = 2 newVal = 4 Case Is = 3 newVal = 3 Case Is = 4 newVal = 2 Case Is = 5 newVal = 1 Case Else newVal = 0 End Select Reverse_Ordinal2 = newVal End Function مرفق المثال و لتشغيله يجب تفعيل الماكرو فى ملف الاكسيل و يتم ادراج الكود فى ملف اخر عن طريق فتح شاشة محرر البيزيك ALT+F11 ثم : السحب للملف الحديد او اختيار ادراج موديول جديد و نسخ الكود او استخدام الدالة و الملف المرفق مفتوح و اذا لم يكن لك خبرة بالتعامل مع الكود ، و لا ترغب فى ذلك ، يمكنك استخدام الملف المرفق مباشرة للتحويل و سحب أو نسخ الدالة للاسفل لتمتد لعدد الاسطر المطلوب ، مع مراعاة تفعيل الماكرو عند فتح الملف لتعمل الدالة ReverseOrdinalLekerd.xlsm1 point
-
اريد ان اغير فكرتك تماماً من تسجيل مستخدم عن طريق حقل نص عند الاضافة سنستخدم رقم لاضافة مستخدم جرب المرفق ادخل مستخدم جديد عن طريق الرقم 1 و وافني بالنتيجة ::بالتوفيق:: ajouter utilisateur.kaser906.1.rar1 point
-
وقلت تحت حتة كود صغير على فكرة تشتغل من غير اكواد بس الليبل هيختفى بمجرد اختيار عنصر من القائمة ومش هيظهر تانى غير لو قفلنا النموذج وفتحناه . مش لازم يبقى فارغ يكفى انه يبقى فيه اى عنصر تانى بخلاف القائمة وبمجرد الانتقال هتشتغل تمام بدون مشاكل وأكيد مفيش نموذج هيبقى فيه قائمة بس لوحدها كده 😄 .. والترتيب Tab Order تكون القائمة مش اول حاجة فى الترتيب . جرب وقولى .0 points