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

لا أدري هل حلي مكرر أم لا تحديد يوم وتاريخ بداية كل أسبوع ونهايته حسب التاريخ الحالي_03.xlsx

وعليكم السلام إن كنت فهم المطلوب فهذا الحل استبدل الكود بالتالي Private Sub CheckBox1_Click() If TextBox1.Text Like "*صنف*" Then For i = 26 To 15 Step -1 If Cells(i, 2) > 0 Then TextBox2.Value = Cells(i, 2): Exit For Next Else For i = 26 To 15 Step -1 If Cells(i, 5) > 0 Then TextBox2.Value = Cells(i, 5): Exit For Next End If End Sub

أشكرك أخي عمر على كلامك الطيب بنظرة سريعة على الكود من الأفضل توحيد الإجراء حتى لا يتكرر مع كل صورة واستدعاء الإجراء فقط ليكون بهذا الشكل ما عليك إلا وضع هذا السطر عند ضغط الصور Call AddItemL(Label2.Caption) فقط غير رقم الليبل Private Sub Image1_Click() Call AddItemL(Label1.Caption) End Sub Private Sub Image2_Click() 'استدعاء الاجراء ووضع اليبل المناسب لكل صورة Call AddItemL(Label2.Caption) End Sub 'توحيد الإجراء Function AddItemL(LabelC As String) X = 0 For i = 0 To Me.ListBox1.ListCount - 1 If Me.ListBox1.List(i, 0) = LabelC Then X = 1 Exit For End If Next i TextBox1 = WorksheetFunction.VLookup(LabelC, Range("d4:h99"), 5, 0) If X = 1 Then 'Me.ListBox1.AddItem Me.ListBox1.List(i, 1) = Me.ListBox1.List(i, 1) + 1 Me.ListBox1.List(i, 2) = Me.ListBox1.List(i, 1) * TextBox1 Else Me.ListBox1.AddItem Me.ListBox1.List(Me.ListBox1.ListCount - 1, 0) = LabelC Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = 1 Me.ListBox1.List(i, 2) = TextBox1 End If End Function

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

وعليكم السلام احذف 'Me.ListBox1.AddItem عند تحقق الشرط ليصبح الكود بهذا الشكل Private Sub Image1_Click() X = 0 For i = 0 To Me.ListBox1.ListCount - 1 If Me.ListBox1.List(i, 0) = Label1.Caption Then X = 1 Exit For End If Next i TextBox1 = WorksheetFunction.VLookup(Label1, Range("d4:h99"), 5, 0) If X = 1 Then 'Me.ListBox1.AddItem Me.ListBox1.List(i, 1) = Me.ListBox1.List(i, 1) + 1 Me.ListBox1.List(i, 2) = Me.ListBox1.List(i, 1) * TextBox1 Else Me.ListBox1.AddItem Me.ListBox1.List(Me.ListBox1.ListCount - 1, 0) = Label1.Caption Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = 1 Me.ListBox1.List(i, 2) = TextBox1 End If End Sub Private Sub Image2_Click() X = 0 For i = 0 To Me.ListBox1.ListCount - 1 If Me.ListBox1.List(i, 0) = Label2.Caption Then X = 1 Exit For End If Next i TextBox1 = WorksheetFunction.VLookup(Label2, Range("d4:h99"), 5, 0) If X = 1 Then 'Me.ListBox1.AddItem Me.ListBox1.List(i, 1) = Me.ListBox1.List(i, 1) + 1 Me.ListBox1.List(i, 2) = Me.ListBox1.List(i, 1) * TextBox1 Else Me.ListBox1.AddItem Me.ListBox1.List(Me.ListBox1.ListCount - 1, 0) = Label2.Caption Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = 1 Me.ListBox1.List(i, 2) = TextBox1 End If End Sub

لانه لاي يجد المسار الموجودة فيه الصورة من الافضل لك ان تضع مجلد ثابت بجانب البرنامج يكون فيه الصور حتى يستطيع البرنامج قراءة المسار منه بالتوفيق https://wayprograms.blogspot.com/

تمام بارك الله فيك اخي الكريم الف شكر

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

توزيع سريع لإحدى الصفحات الجمعية 9.rar

لوجود ملاحظات اخرى على التسميات .. انتظرني سوف اصحح المرفق ثم ارفعه مثلا التسميات يجب الا تتكرر في الجداول الاخرى وان يكون بينها فرق بسيط .. وهذا ستجد فائدته عند جلب الحقول وتجميعها في الاستعلامات

أسعدني مروركم العطر أخي الكريم @AbuuAhmed على موضوعي هذا جزاكم الله خيراً. أثريت موضوعنا بهذه المشاركة الطيبة تقبل تحياتي العطرة.

السلام عليكم 1- الجداول الثلاث الاخيرة جيدة _ فقط جدول السنوات اجعل الحقل نصي ادخال وليس مربع تحرير لانك كل سنة سوف تضيف تاريخ جديد مع بقاء الاول 2- الجداول السبعة الاولى اختزلها في جدول واحد للعمليات ، واعمل جدول للمحاصيل ( معرف / المحصول) فقط .. تختار المحصول في جدول العمليات من خلال مربع التحرير. 3- لا تترك مسافات خالية بين كلمات مسميات الحقول في تصميم الجدول

الاصل وهو الاولى فتح موضوع جديد والاشارة الى رابط هذا الموضوع للاستفادة منه الموضوع قديم قبل 8 سنوات واصحابه _ بحفظ الله _ غير متواجدين يغلق ،،،

بالنسبة لمن يستخدم نسخ قديمة فيه موضوع قديم اسمه بدائل textjoin فيه دالة معرفة vba يممكن استعمالها بنفس الطريقة

لا مشكلة اذا استخدمت معادلة العد بشرط =IF(AND(COUNTIF($A$2:$A$20, A2)>1, COUNTIF($A$2:A2, A2)=1), TEXTJOIN(",", 1,IF($A$2:$A$20=A2,$B$2:$B$20, "")),"") موفق ان شاء الله