عبدالله المجرب

واليك هذا العمل المميز بالاكواد http://www.officena.net/ib/index.php?showtopic=18457

السلام عليكم جرب هذا الموضوع http://www.officena.net/ib/index.php?showtopic=40848

اخي محمدي تم افتتاح مكتبة الاكواد وهذا رابطه http://www.officena.net/ib/index.php?app=downloads&showcat=16 لما لا تستغله في هذه السلسلة التعليمية حتي يسهل الرجوع اليه والامر متروك لك

اخي الفاضل لا يتم ادراج المعادلات في الكود وانما اخذها من الخلايا الخضراء ======== في البداية جرب ان تغيير في خلية التفاصيل وسترى النتيجة ------------------------------------------------ للعلم تفعيل الكود يعتمد على التغيير في خلية التفاصيل اما اذا اردت التفعيل يشمل التغيير في خلية الوكيل (اي بعد اختيار الوكيل يتم تفعيل الكود ) سيكون الكود هكذا Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, [D7:D1000,F7:F1000]) Is Nothing Then For i = 8 To 12 Cells(Target.Row, i).FormulaR1C1 = Cells(4, i).FormulaR1C1 Cells(Target.Row, i).Value = Cells(Target.Row, i) Next End If End Sub

هذه تخص الاستاذ عبدالله باقشير وننتظر منه الافادة

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

بارك الله فيك يا استاذ احمد والله ييسر أمرك ابواحمد

السلام عليكم هذا الملف وبه معظم ما طلبت من عبد الله الى ابو شرف.rar

الاستاذ الفاضل نارت (ابوادم) نسأل الله ان يديم عليك نعمة الصحة والعافية ويبارك لك في مالك ورزقك وولدك وللاخ محمد أيمن مثل ذلك بارك الله فيكم ونفع بعلمكم

السلام عليكم اخي ابوشرف التعديلات الخصة بالشرح والموقع ممكنه غير مفهوم للاسف ======= سيتم المحاولة دون وعد بالنجاح ======= كيف !!

السلام عليكم اخي الكريم ما الخلل في الكود فلم افهم ما تقصده

السلام عليكم ضع ترويسة في الورقة Anas وضع صف به بيانات واليك التعديل على زري الخطاء Private Sub CommandButton3_Click() 'زر حذف Application.ScreenUpdating = False For i = 1 To 100 If Val(TextBox1.Text) = Cells(i, 1) Then rr = Cells(i, 1).Row If rr = 1 Then Exit Sub Cells(i, 1).EntireRow.Delete shift:=xlUp TextBox1.Text = Cells(rr - 1, 1) TextBox2.Text = Cells(rr - 1, 2) TextBox3.Text = Cells(rr - 1, 3) TextBox4.Text = Cells(rr - 1, 4) TextBox5.Text = Cells(rr - 1, 5) End If Next i Application.ScreenUpdating = True TextBox1.SetFocus End Sub Private Sub CommandButton4_Click() 'زر اضافة 'هذا هو الخطأ bb = Range("a" & r).Offset(1, 0).Select Sheets("Anas").Activate For i = 2 To 1000 If Cells(i, 2) <> "" Then Cells(i, 1) = i - 1 End If Next r = [a1000].End(xlUp).Row bb = Range("a" & r).Offset(1, 0).Select ActiveCell = Cells(r, 1).Value + 1 TextBox1.Text = Cells(ActiveCell.Row, 1) Cells(ActiveCell.Row, 2) = TextBox2.Text Cells(ActiveCell.Row, 3) = Val(TextBox3.Text) Cells(ActiveCell.Row, 4) = TextBox4.Text Cells(ActiveCell.Row, 5) = TextBox5.Text TextBox1.SetFocus End Sub

سبحان الله

انا مع راي الاستاذ ابو ادم لتطوير الملف وتطعيمه بالافكار

السلام عليكم أستاذنا الجليل دائما جميل - جميل -جميل ماشاء الله تبارك الله زادك الله من فضله وعلمه ورزقك وبارك لك في وقتك وجهدك وأهلك ومن تحب جميعا تلميذكم عبدالله المجرب

وهذا حل أخر =SUM(SUMPRODUCT((A2:A7="محمد")*(B2:B7));SUMPRODUCT((A2:A7="احمد")*(B2:B7)))

شاهد هذا الرابط

وضح اكثر لو تسمح

يرجى الالتزام بقواعد المشاركة تم تعديل العنوان للدلالة

السلام عليكم استبدل كود الزر (CommandButton1) بهذا Private Sub CommandButton1_Click() On Error Resume Next Dim KH As Integer Dim S As Long, R As Long If TabStrip1.Value = 1 Then GoTo 2 KH_NO = Range("رقم_الفاتورة")(2) If Combo_AMIL.Text = "" Or ComboBox21.Text = "" Then GoTo 1 LastRow = Cells(Rows.Count, "B").End(xlUp).Row KH = 0 M = 0 T = 0 For S = 1 To 20 If Me.Controls.Item(KH).Text <> "" Then For R = 1 To 5 If Me.Controls.Item(KH + R - 1).Text <> "" Then T = T + 1 End If Next M = M + 1 End If KH = KH + 5 Next If T / M <> 5 Then 1 MsgBox "لا تستطيع الترحيل لوجود أخطاء في الفاتورة", 524288, "تنبيه" GoTo 3 End If ' LastRow = Cells(Rows.Count, "B").End(xlUp).Row KH = 0 For S = 1 To M Cells(LastRow + S, 2) = Date Cells(LastRow + S, 3) = KH_NO Cells(LastRow + S, 4) = Combo_AMIL.Text Cells(LastRow + S, 10) = ComboBox21.Text Cells(LastRow + S, 5) = Me.Controls.Item(KH).Value Cells(LastRow + S, 6) = Me.Controls.Item(KH + 1).Value If ComboBox21.Text = "ترجيع" Or ComboBox21.Text = "شراء" Then For R = 3 To 5 Cells(LastRow + S, R + 4) = "-" & Me.Controls.Item(KH + R - 1).Value Next Else For R = 3 To 5 Cells(LastRow + S, R + 4) = Me.Controls.Item(KH + R - 1).Value Next End If KH = KH + 5 Next If MsgBox(" تم الترحيل بنجاح" _ & Chr(13) & Chr(13) & "هل تريد طباعة الفاتورة ؟؟؟", vbYesNo + vbQuestion + vbMsgBoxRight, "تأكيد طباعة ") = vbYes Then 2 KHBOOR = InputBox("فضلاً أدخل عدد نسخ الاوراق الذي تريدها " & Chr(13) & Chr(13) & "الافتراضي نسخة واحدة", "عدد النسخ", "1") KH_PRINT End If End On Error GoTo 0 3 End Sub

السلام عليكم اليك ما طلبت مساعدة في فاتورة.rar

شكراً على المعلومة المفيدة وان شاء الله ان كان لديك النية لتقديم معلومات بهذه الطريقة ان تضعها في موضوع واحد (اجعل هذا الموضوع هو الاساس) لتعم الفائدة وسيتم تغيير عنوان الموضوع ان اردت

ان شاء الله هذا الملف به الحل ونفس النواتج بدوال الاكسل العادية دون الحاجة الى دالة معرفة عد الايام بين تاريخ دون عطل مع إستثناء تواريخ محددة.rar

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