Как сохранить или удержать выбор в элементах ActiveX списка в Excel?
Предположим, вы создали несколько списков и сделали выбор в этих списках, однако все выборы исчезают при закрытии и повторном открытии книги. Хотите ли вы сохранять выборы, сделанные в списках, каждый раз при закрытии и повторном открытии книги? Метод, описанный в этой статье, может помочь вам.
Сохранение или удержание выбора в элементах ActiveX списка с помощью кода VBA в Excel
Сохранение или удержание выбора в элементах ActiveX списка с помощью кода VBA в Excel
Следующий код VBA поможет вам сохранить или удержать выбор в элементах ActiveX списка в Excel. Пожалуйста, действуйте следующим образом.
1. В книге, содержащей элементы ActiveX списка, для которых вы хотите сохранить выбор, одновременно нажмите клавиши Alt + F11, чтобы открыть окно Microsoft Visual Basic for Applications.
2. В окне Microsoft Visual Basic for Applications дважды щелкните ThisWorkbook в левой панели, чтобы открыть окно ThisWorkbook кода. Затем скопируйте следующий код VBA в окно кода.
Код VBA: Сохранение выбора элементов ActiveX списка в Excel
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim I As Long
Dim J As Long
Dim K As Long
Dim KK As Long
Dim xSheet As Worksheet
Dim xListBox As Object
On Error GoTo Label
Application.DisplayAlerts = False
Application.ScreenUpdating = False
K = 0
KK = 0
If Not Sheets("ListBox Data") Is Nothing Then
Sheets("ListBox Data").Delete
End If
Label:
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "ListBox Data"
Set xSheet = Sheets("ListBox Data")
For I = 1 To Sheets.Count
For Each xListBox In Sheets(I).OLEObjects
If xListBox.Name Like "ListBox*" Then
With xListBox.Object
For J = 0 To .ListCount - 1
If .Selected(J) Then
xSheet.Range("A1").Offset(K, KK).Value = "True"
Else
xSheet.Range("A1").Offset(K, KK).Value = "False"
End If
K = K + 1
Next
End With
K = 0
KK = KK + 1
End If
Next
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Private Sub Workbook_Open()
Dim I As Long
Dim J As Long
Dim KK As Long
Dim xRg As Range
Dim xCell As Range
Dim xListBox As Object
Application.DisplayAlerts = False
Application.ScreenUpdating = False
KK = 0
For I = 1 To Sheets.Count - 1
For Each xListBox In Sheets(I).OLEObjects
If xListBox.Name Like "ListBox*" Then
With xListBox.Object
Set xRg = Intersect(Sheets("ListBox Data").Range("A1").Offset(0, KK).EntireColumn, Sheets("ListBox Data").UsedRange)
For J = 1 To .ListCount
Set xCell = xRg(J)
If xCell.Value = "True" Then
.Selected(J - 1) = True
End If
Next
KK = KK + 1
End With
End If
Next
Next
Sheets("ListBox Data").Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
3. Нажмите клавиши Alt + Q, чтобы закрыть окно Microsoft Visual Basic for Applications.
4. Теперь вам нужно сохранить книгу как книгу Excel с поддержкой макросов. Пожалуйста, нажмите Файл > Сохранить как > Обзор.
5. В диалоговом окне «Сохранить как» выберите папку для сохранения книги, переименуйте её по необходимости, выберите Книга Excel с поддержкой макросов в раскрывающемся списке «Указать формат сохранения», и, наконец, нажмите кнопку Сохранить. См. скриншот:
Пожалуйста, сохраняйте книгу каждый раз, когда обновляете списки. Тогда все предыдущие выборы будут сохранены в списках после повторного открытия книги.
Примечание: При сохранении книги автоматически будет создана таблица с именем «ListBox Data» в конце всех таблиц вашей книги, пожалуйста, игнорируйте эту таблицу, так как она исчезнет автоматически при закрытии книги.
Лучшие инструменты для повышения продуктивности в Office
Повысьте свои навыки работы в Excel с помощью Kutools для Excel и ощутите эффективность на новом уровне. Kutools для Excel предлагает более300 расширенных функций для повышения производительности и экономии времени. Нажмите здесь, чтобы выбрать функцию, которая вам нужнее всего...
Office Tab добавляет вкладки в Office и делает вашу работу намного проще
- Включите режим вкладок для редактирования и чтения в Word, Excel, PowerPoint, Publisher, Access, Visio и Project.
- Открывайте и создавайте несколько документов во вкладках одного окна вместо новых отдельных окон.
- Увеличьте свою продуктивность на50% и уменьшите количество щелчков мышью на сотни ежедневно!
Все надстройки Kutools. Один установщик
Пакет Kutools for Office включает надстройки для Excel, Word, Outlook и PowerPoint, а также Office Tab Pro — идеально для команд, работающих в разных приложениях Office.
- Комплексный набор — надстройки для Excel, Word, Outlook и PowerPoint плюс Office Tab Pro
- Один установщик, одна лицензия — настройка занимает считанные минуты (MSI-совместимо)
- Совместная работа — максимальная эффективность между приложениями Office
- 30-дневная полнофункциональная пробная версия — без регистрации и кредитной карты
- Лучшее соотношение цены и качества — экономия по сравнению с покупкой отдельных надстроек