عبده الطوخى 1970 قام بنشر منذ 14 ساعات قام بنشر منذ 14 ساعات السلام عليكم ورحمه الله وبركاته لدى ComboBox1 يتم اختيار الصفحة منه ثم البحث من خلال كتابة التاريخ فى TextBox2 ثم الضغط على زر امر CommandSearchDate يتم عرض العناصر المطلوبة فى ListBox1 و ListBox2 المطلوب كود يعمل على حذف الصفوف المحددة فى ListBox1 وحذفها من الصفحة المحددة الموجودة ComboBox1 مع التحديد باى لون حتى ارى الصفوف المراد حذفها وتم عمل كود ولكن لا يعمل بالكشل المطلوبة (( مرفق الكود )) Private Sub CommandButtonDelete_Click() Dim sheetName As String Dim ws As Worksheet Dim i As Long Dim selectedRow As Long Dim selectedItems As Collection Dim response As VbMsgBoxResult ' ÊÍÞÞ ãä Ãä åäÇß ÚäÕÑðÇ ãÍÏÏðÇ Ýí ListBox1 If ListBox1.ListIndex = -1 Then MsgBox "ãä ÝÖáß ÍÏÏ ÇáÕÝæÝ ÇáÊí ÊÑíÏ ÍÐÝåÇ ãä ÇáÞÇÆãÉ.", vbExclamation Exit Sub End If ' ÇáÊÃßÏ ãä ÑÛÈÉ ÇáãÓÊÎÏã Ýí ÇáÍÐÝ response = MsgBox("åá ÃäÊ ãÊÃßÏ ãä ÍÐÝ ÇáÕÝæÝ ÇáãÍÏÏÉ ãä ÇáæÑÞÉ¿", vbYesNo + vbExclamation, "ÊÃßíÏ ÇáÍÐÝ") If response = vbNo Then Exit Sub ' ÇáÍÕæá Úáì ÇÓã ÇáæÑÞÉ ÇáãÍÏÏÉ sheetName = ComboBox1.Value ' ÇáÊÍÞÞ ãä æÌæÏ ÇáæÑÞÉ ÇáãÍÏÏÉ On Error Resume Next Set ws = ThisWorkbook.Sheets(sheetName) On Error GoTo 0 If ws Is Nothing Then MsgBox "ÇáæÑÞÉ ÇáãÍÏÏÉ ÛíÑ ãæÌæÏÉ!", vbExclamation Exit Sub End If ' ÅÚÏÇÏ ÇáÜ Collection áÍÝÙ ÇáÕÝæÝ ÇáãÍÏÏÉ Set selectedItems = New Collection For i = 0 To ListBox1.ListCount - 1 ' ÇáÊÍÞÞ ãä Ãä ÇáÚäÕÑ ÇáãÍÏÏ Ýí ListBox1 åæ ÑÞã ÕÍíÍ If ListBox1.Selected(i) Then If IsNumeric(ListBox1.List(i, 0)) Then ' ÅÐÇ ßÇä ÇáÑÞã ÕÇáÍðÇ¡ ÃÖÝå Åáì ÇáÜ Collection selectedRow = CLng(ListBox1.List(i, 0)) ' ÅÖÇÝÉ ÑÞã ÇáÕÝ ÇáãÍÏÏ selectedItems.Add selectedRow ' ÅÖÇÝÉ ÇáÕÝ Åáì ÇáÜ Collection ElseIf IsDate(ListBox1.List(i, 0)) Then ' ÅÐÇ ßÇäÊ ÇáÞíãÉ ÊÇÑíÎðÇ¡ ÍæáåÇ Åáì ÇáÑÞã ÇáãÞÇÈá áåÇ Ýí ÇáæÑÞÉ MsgBox "Êã ÊÍÏíÏ ÊÇÑíÎ: " & ListBox1.List(i, 0), vbInformation ' åäÇ íãßä æÖÚ ãäØÞ ÂÎÑ ÅÐÇ ßäÊ ÈÍÇÌÉ ááÊÚÇãá ãÚ ÇáÊæÇÑíÎ ÈÔßá ÎÇÕ Else MsgBox "ÇáÕÝ ÇáãÍÏÏ áíÓ ÑÞãðÇ ÕÇáÍðÇ Ãæ ÊÇÑíÎðÇ: " & ListBox1.List(i, 0), vbCritical Exit Sub End If End If Next i ' ÇáÊÍÞÞ ãä Ãäå Êã ÊÍÏíÏ ÕÝæÝ ááÍÐÝ If selectedItems.Count = 0 Then MsgBox "áã ÊÞã ÈÊÍÏíÏ Ãí ÕÝæÝ áÍÐÝåÇ.", vbExclamation Exit Sub End If ' ÅíÞÇÝ ÊÍÏíË ÇáÔÇÔÉ áÊÓÑíÚ ÇáÚãáíÉ Application.ScreenUpdating = False ' ÍÐÝ ÇáÕÝæÝ ÇáãÍÏÏÉ ÈÏÁðÇ ãä ÇáÕÝ ÇáÃÎíÑ áÖãÇä ÚÏã ÊÛííÑ ÊÑÊíÈ ÇáÕÝæÝ For i = selectedItems.Count To 1 Step -1 selectedRow = selectedItems(i) ws.Rows(selectedRow + 1).Interior.Color = RGB(255, 255, 0) ' ÊãííÒ ÇáÕÝ ÈÇááæä ÇáÃÕÝÑ ws.Rows(selectedRow + 1).Delete ' ÍÐÝ ÇáÕÝ Next i Application.ScreenUpdating = True ' ÅÚÇÏÉ ÊÝÚíá ÊÍÏíË ÇáÔÇÔÉ ' ÅÒÇáÉ ÇáÚäÇÕÑ ÇáãÍÐæÝÉ ãä ListBox1 For i = ListBox1.ListCount - 1 To 0 Step -1 If ListBox1.Selected(i) Then ListBox1.RemoveItem i End If Next i ' ÚÑÖ ÑÓÇáÉ ÊÃßíÏ ÈÚÏ ÚãáíÉ ÇáÍÐÝ MsgBox "Êã ÍÐÝ ÇáÕÝæÝ ÇáãÍÏÏÉ ÈäÌÇÍ.", vbInformation End Sub نموذج الكهرباء _ اكسيل.xlsm
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.