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

شكرا استاذ (Foksh) التخزين جاهز في الحقول بعد اضافتها بقي المساعده في ان تكون باقي المده صحيحه سوف اجرب مداخله الاستاذ Eng.Qassim

الاخ @gamal gamal دي حاجة انا عملتها في البرنامج بتاعي ممكن تكون هى طلبك جربها وقولي النتيجة Gamal.accdb تمام فهمت اخ @Foksh وعملت زي ما حضرتك قولت بس واضح ان المشكلة عندي لان عندي شاشة سيريال البرنامج بتكون غير فعالة بعد التحويل وبالتالي البرنامج مش بيفتح لس هحاول فيها ان شاء الله

عملت لك النتيجة بشكل رسالة فقط جرب بعض المدخلات التاريخ.accdb

ابشر أخي أوصل البيت وبسويها انشاء الله .

تفضل أخي محاولتي بالشرح والمرفق . ووافني بالرد . DD439.rar

تابع هذا الموضوع ...

The error is because you have protected your worksheets so I think you encountered the error. To fix the problem just unprotect the worksheet before working on it and at the end to protect it again Sub HideRowsBasedOnCondition() Dim conditionValue, ws As Worksheet, conditionCell As Range, rowRange As Range For Each ws In ThisWorkbook.Sheets Set conditionCell = ws.Range("V1") conditionValue = conditionCell.Value ws.Unprotect ws.Rows.Hidden = False If conditionValue = 28 Then Set rowRange = ws.Rows("1363:1387") rowRange.Hidden = True ElseIf conditionValue = 29 Then Set rowRange = ws.Rows("1361:1362") rowRange.Hidden = True End If ws.Protect Next ws End Sub I just added two lines ws.Unprotect And ws.Protect

شكرا لك هذا ما اريده

Is this problem related to a specific workbook or any workbook Attach the file if it is related to a sepcific workbook

What about Application.SendKeys "^f" DoEvents SendKeys "{NUMLOCK}{NUMLOCK}"

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

TEST.accdb

أضف هذه الدالة إلى الوحدة النمطية (المديول): Sub mySendKeys(String_ As String, Optional Wait As Boolean = False) Dim WshShell As Object Set WshShell = CreateObject("WScript.Shell") WshShell.SendKeys String_, Wait Set WshShell = Nothing End Sub ليصبح الأمر أعلاه كالتالي: mySendKeys "^f", True

مشاركة مع الاساتذه الكرام الاخ شايب يعتقد ان فكرة نموذج بحث التي اشار اليها الاساتذة فكرة معقولة ولكن يمكن التوصل للمطلوب بدون الحاجة الى ذلك حيث ان اخفاء او اظهار تبويب استبدال في نافذة البحث مرتبط بحالة التعديل للنموذج نعم او لا وبالتالي يمكن اضافة السطر Me.AllowEdits = False قبل الكود الذي تستخدمه ولكن لابد ان تعيد تغيير الخاصة الى نعم بعد تنفيذ البحث او في اي حدث اخر لتتمكن من تعديل البيانات في النموذج اخونا الشايب

تفضل أخي @sm44ms المرفق بعد التعديل . DD437-1.rar

انشاء الله بس ارجع البيت. ابشر

تفضل عدل العملة فقط فى النموذج تفقيط الارقام فى الاكسس.accdb

تفضل استاذنا المرفق بعد التعديل . new1.accdb

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

ياليت كرما يتم ارفاق المثال ب اصدار 2003 لتعم الفائدة وفقكم الله

السلام عليكم أستاذ جعفر مالمقصود بالوحدة النمطيه ؟؟ (مقتبس : نقوم بإنشاء وحدة نمطية جديدة و نلصق بها الكود التالي: )

الله يحفظك بالتوفيق إن شاء الله

السلام عليكم أخي العزيز المرفق (بالورقة Statment) به كود يعمل التالي: يقوم بتكوين معادلات بالمنطقة الصفراء الأعمدة V:W لتحسب العدد المباع / اجمالي مبلغ مبيعات الصنف / الربح وكذلك يحسب بدون معادلات (اجمالي مبلغ شراء الكمية المباعة) بالعمود U ويتم تفعيل الكود إذا ضغطت الزر أو إذا نشطت الورقة Statment وكذلك إذا وقفت علي إحدي خلايا العمود U ، يعطي لك في صورة تعليق Comment يعطي ملخص لكيفية حساب مبلغ شراء الكمية المباعة لاحظ: علامة الـ (+) أعلي العمود T لإظهار / إخفاء الأعمدة الداخلية هذا كود الحساب Sub net_profit() 'By Tareq MAHMOUD LR = [D10000].End(xlUp).Row Dim Q(99), P(99) As Variant For r = 3 To LR cod = Cells(r, "D").Value With Sheets("Buys") LR2 = .[C10000].End(xlUp).Row I = 0 For nr = 2 To LR2 If .Cells(nr, "C").Value = cod Then I = I + 1 Q(I) = .Cells(nr, "F").Value P(I) = .Cells(nr, "H").Value End If Next nr End With Cells(r, "T").FormulaR1C1 = "=SUMIF(R2C5:RC[-15],RC[-15],R2C6:RC[-14])" Cells(r, "V").FormulaR1C1 = "=SUMIF(R2C5:RC[-17],RC[-17],R2C8:RC[-14])" Cells(r, "W").FormulaR1C1 = "=RC[-1]-RC[-2]" x = Cells(r, "T").Value T_x = 0 For j = 1 To I If x < Q(j) Then T_x = T_x + x * P(j): GoTo 10 x = x - Q(j): T_x = T_x + Q(j) * P(j) Next j 10 Cells(r, "U").Value = T_x Next r End Sub وهذا كود التعليق Comment Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'By Tareq MAHMOUD If Target.Column <> 21 Then Exit Sub LR = [D10000].End(xlUp).Row r = Target.Row If r > LR Then Exit Sub cod = Cells(r, "D").Value Range("U3:U" & LR).ClearComments Dim Q(99), P(99) As Variant With Sheets("Buys") LR2 = .[C10000].End(xlUp).Row I = 0 For nr = 2 To LR2 If .Cells(nr, "C").Value = cod Then I = I + 1 Q(I) = .Cells(nr, "F").Value P(I) = .Cells(nr, "H").Value End If Next nr End With x = Cells(r, "T").Value T_x = 0 tt_TX = "" For j = 1 To I If x < Q(j) Then T_x = T_x + x * P(j): tt_TX = tt_TX & " " & x & "x" & P(j) & Chr(10): GoTo 10 tt_TX = tt_TX & " " & Q(j) & "x" & P(j) x = x - Q(j): T_x = T_x + Q(j) * P(j) Next j 10 With ActiveCell .AddComment .Comment.Text Text:=tt_TX End With End Sub تفضل المرفق ربح صنف متعدد سعر الشراء2.rar