اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

الردود الموصى بها

قام بنشر

السلام عليكم ورحمه الله وبركاته 

لدى 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.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information