VBA, Отменить выбор элементов в ListBox, которые сначала должны быть выбраны - PullRequest
0 голосов
/ 04 ноября 2018

Следующая проблема: 1) Я заставляю некоторые элементы быть выбранными в ListBox поверх кода VBA 2) Откройте UserForm и выберите или отмените выбор некоторых пунктов. (все выглядит нормально в ListBox) 3) Запишите выбранные элементы. Если я выберу только несколько новых предметов, все будет хорошо. Если я отменил выбор выбранного элемента, который я принудительно выбрал в начале, он все равно будет выбран в выводе.

With Sheets("ID_Mitarbeiter").Range("A2:A1048576")
 Set c = .Find(What:=TextBox_ID, lookat:=xlWhole)
 If Not c Is Nothing Then
    firstAddress = c.Address
    Do
        ListBox_Mitarbeiter.Selected(Sheets("ID_Mitarbeiter").Cells(c.Row, 2) - 1) = True
        Set c = .FindNext(c)
    If c Is Nothing Then
        GoTo DoneFinding
    End If
    Loop While c.Address <> firstAddress
  End If

DoneFinding: Конец

1 Ответ

0 голосов
/ 06 ноября 2018
Private Sub Butto_Change_Click()
Dim ind_pers As Integer

With ListBox_Mitarbeiter
If .ListCount > 0 Then
    ind_pers = 0
    For i = 0 To .ListCount - 1
        If .Selected(i) = True Then
        Cells(ind_pers, 1).Value = 1
        Cells(ind_pers, 2).Value = i + 1
        ind_pers = ind_pers + 1
        Else
        End If
    Next i
    Else
End If
End With

End Sub

Private Sub ComboBox1_Change()

TextBox_IndexStart.Value = Sheets("ID_Mitarbeiter").Range("A2:A1048576").Find(What:=TextBox_ID.Value, lookat:=xlWhole).Row

With Sheets("ID_Mitarbeiter").Range("A2:A1048576")
     Set c = .Find(What:=TextBox_ID, lookat:=xlWhole)
     If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            ListBox_Mitarbeiter.Selected(Sheets("ID_Mitarbeiter").Cells(c.Row, 2) - 1) = True
            Set c = .FindNext(c)
        If c Is Nothing Then
            GoTo DoneFinding
        End If
        Loop While c.Address <> firstAddress
      End If
DoneFinding:
End With

End If
End Sub


Private Sub UserForm_Initialize()
Dim last As Integer
Dim cnt As Integer

last = Sheets("Mitarbeiter").Cells(Rows.Count, 1).End(xlUp).Row

For cnt = 2 To last
    With ListBox_Mitarbeiter
    .AddItem Sheets("Mitarbeiter").Cells(cnt, 2).Value & " " & Sheets("Mitarbeiter").Cells(cnt, 3).Value
    End With
Next cnt
End Sub

Этот код работает нормально. Но когда я в пользовательском интерфейсе отменяю выбор элементов, он все равно записывает все выбранные элементы.

...