ازالة الفرغات فى اليست بوكس عند الترحيل

[عمر الجزاوى]

السلام عليكم ورحمة الله وبركاته كل عام وحضراتكم بخير عندى مشكلة فى عند الضغط على زر سندوتشات يحضر لى اسماء الاصناف عند الضغط على منتج من imege وليس من Label يبدء فى زيادة الكمية عند اختيارى سندويش كودو ضغط على الصنف مرات وعند اختيار الصنف الثانى وهو سنودش كبده ترك 7 فراغات وظهر الصنف ممكن ازالة الفراغ وتصليح الكود حتى ان اخذ اى كمية من الصنف واضع النف الاخر لا يترك فراغ بين الصنف والصنف وجزاكم الله خير الجزاء وجعله فى ميزان حسناتكم

الليست بوكس.xlsm

[أبوأحـمـد]

وعليكم السلام

احذف '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

 

[عمر الجزاوى]

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

[أبوأحـمـد]

أشكرك أخي عمر على كلامك الطيب

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

ما عليك إلا وضع هذا السطر عند ضغط الصور

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

 

[عمر الجزاوى]

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

الاكواد الازرار بداخل الملف

[أبوأحـمـد]

تفضل

Private Sub CommandButton7_Click()
Call Addimg(CommandButton7.Caption)
End Sub
Private Sub CommandButton8_Click()
Call Addimg(CommandButton8.Caption)
End Sub
Private Sub CommandButton9_Click()
Call Addimg(CommandButton9.Caption)
End Sub
Private Sub CommandButton10_Click()
Call Addimg(CommandButton10.Caption)
End Sub
Private Sub CommandButton11_Click()
Call Addimg(CommandButton11.Caption)
End Sub
'توحيد الإجراء
Function Addimg(CommandC As String)
Dim ws As Worksheet: Set ws = Sheets("البيانات")
Dim sh As Worksheet: Set sh = Sheets("الفلتر")
sh.Range("a4:j150") = ""
sh.[f1].Value = CommandC
k = 4
lr = ws.Range("c" & Rows.Count).End(xlUp).Row
For R = 5 To lr
If ws.Range("c" & R) = sh.Range("f1") Then
For j = 1 To 10
sh.Cells(k, j) = ws.Cells(R, j)
Next
k = k + 1
End If
Next
X = sh.Range("d999").End(xlUp).Row
For i = 1 To X
Controls("Label" & i).Caption = sh.Cells(i + 3, 4)
Next
End Function

 

[عمر الجزاوى]

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

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

ادامك الله فى طاعته

[أبوأحـمـد]

أخي عمر هذا من طيبك ونبل أخلاقة وكرمك

ما قمت به يمكن أن يقوم به أي شخص مبرمج فهي من أساسيات البرمجة