Как сохранить или оставить выделенные элементы в полях со списком ActiveX в Excel?
Предположим, вы создали несколько полей со списком и выбрали в них нужные значения, однако при закрытии и повторном открытии книги все выбранные значения исчезают. Хотите ли вы сохранять сделанные вами выборы в полях со списком каждый раз при закрытии и повторном открытии книги? Метод, описанный в этой статье, поможет вам в этом.
Сохранение или удержание выделенных элементов в полях со списком ActiveX с помощью кода VBA в Excel
Сохранение или удержание выделенных элементов в полях со списком ActiveX с помощью кода VBA в Excel
Приведённый ниже код VBA поможет вам сохранять выделенные элементы в полях со списком ActiveX в Excel. Выполните следующие действия.
1. В книге, содержащей поля со списком ActiveX, выборы в которых вы хотите сохранить, одновременно нажмите клавиши Alt+F11, чтобы открыть окно Microsoft Visual Basic для приложений.
2. В окне Microsoft Visual Basic для приложений дважды щёлкните по элементу ЭтаКнига на левой панели, чтобы открыть окно кода ЭтаКнигаКод. Затем скопируйте приведённый ниже код 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 для приложений.
4. Теперь необходимо сохранить книгу как книгу Excel с поддержкой макросов. Нажмите Файл > Сохранить как > Обзор.
5. В диалоговом окне Сохранить как укажите место для сохранения книги, при необходимости переименуйте её, выберите тип файла Книга Excel с поддержкой макросов в раскрывающемся списке Указать формат сохранения и нажмите кнопку Сохранить. См. снимок экрана:
Не забывайте сохранять книгу после каждого обновления полей со списком — так все ранее сделанные выборы останутся в полях со списком и после повторного открытия книги.
Примечание: При сохранении книги в конце всех листов автоматически создаётся лист с именем «Данные списка». Игнорируйте его — он исчезнет автоматически при закрытии книги.
Лучшие инструменты повышения продуктивности в 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-дневная полнофункциональная пробная версия— без регистрации и кредитной карты
- Лучшее соотношение цены и качества— экономия по сравнению с покупкой отдельных надстроек