🎛 Программное создание элементов управления

Рассмотрим программное (динамическое) создание элементов управления формы в VBA Excel для отображения расстояний от Солнца до планет Солнечной системы. Созданный элемент ComboBox будет реагировать на событие ComboBox_Change().

1️⃣ Создайте пользовательскую форму.
2️⃣ Разместите код в модуле формы.

📌 Код VBA Excel

Option Explicit
'Объявляем переменные для создания меток
Dim lb1, lb2
'Объявляем переменную для поля со списком,
'которая будет обрабатывать события
'благодаря ключевому слову WithEvents
Private WithEvents cb1 As MSForms.ComboBox


Private Sub UserForm_Initialize()
With Me
    .Height = 170
    .Width = 305
    .Caption = "Расстояние от Солнца до планет Солнечной системы"
    'Программно создаем элементы управления
    Set lb1 = .Controls.Add("Forms.Label.1")
    Set lb2 = .Controls.Add("Forms.Label.1")
    Set cb1 = .Controls.Add("Forms.ComboBox.1")
End With

With lb1
    .Height = 22
    .Width = 290
    .Top = 60
    .Left = 18
    .Font.Size = 12
    .Caption = "Расстояние от Солнца до выбранной планеты"
End With

With lb2
    .Caption = ""
    .Height = 22
    .Width = 290
    .Top = 90
    .Left = 18
    .Font.Size = 14
End With

With cb1
    .Height = 22
    .Width = 150
    .Top = 20
    .Left = 18
    .Font.Size = 12
    .List = Array("Меркурий", "Венера", "Земля", _
    "Марс", "Юпитер", "Сатурн", "Уран", "Нептун")
    .Value = "Выберите планету"
End With
End Sub


Private Sub cb1_Change()
Dim pl(), km()
pl = Array("Меркурия", "Венеры", "Земли", _
    "Марса", "Юпитера", "Сатурна", "Урана", "Нептуна")
km = Array("57,91 млн км (0,387 а. е.)", "108 млн км (0,723 а. е.)", _
    "149,6 млн км (1 а. е.)", "228 млн км (1,52 а. е.)", _
    "778,57 млн км (5,2 а. е.)", "1,43 млрд км (9,58 а. е.)", _
    "2,87 млрд км (19,1914 а. е.)", "4,55 млрд км (30,1 а. е.)")
        If cb1.ListIndex > -1 Then
            lb1.Caption = "Расстояние от Солнца до " & pl(cb1.ListIndex) & ":"
            lb2.Caption = km(cb1.ListIndex)
        End If
End Sub

Исправил незначительную ошибку, которая вызывала перенос строки в первой метке.

#VBA #ExcelVBA #Элемент #ComboBox #Label #Создание

✏️ Модификатор WithEvents в VBA Excel

WithEvents в VBA Excel используется при объявлении переменной, чтобы разрешить ей обрабатывать события объекта. Это позволяет, например, реагировать на нажатие кнопки или изменение текста в поле формы.

💡 Что такое WithEvents - оператор или ключевое слово?

📎 WithEvents — это:
✅ Ключевое слово (входит в синтаксис языка).
✅ Модификатор переменной (добавляет поддержку событий).
❌ Не оператор (не выполняет действий).

📍 Пример использования:

Private WithEvents Btn As MSForms.CommandButton

Теперь переменная Btn, после присвоения ей ссылки на кнопку, созданную методом Add, может вызывать, например, событие Btn_Click.

📚 Правила и ограничения WithEvents:
🔹 WithEvents используется только в модулях классов или формы, где требуется обработка событий объектов.
🔹 Нельзя использовать WithEvents для элемента структуры. Можно объявить только отдельные переменные, а не массивы WithEvents.
🔹 Переменная с WithEvents должна быть объявлена как объектная, но конкретного класса, который может вызывать события: As MSForms.Label, As MSForms.ComboBox, As MSForms.CommandButton и т.д. То есть, объявление As Object не подходит.

#VBA #ExcelVBA #WithEvents #Форма #Переменная #Событие

💫 Удаляющаяся и приближающаяся строка
Кроме бегущей строки интересную анимацию можно создать с помощью удаляющихся и приближающихся строк.

Для создания эффекта удаляющейся и приближающейся строки используется функция Timer для задержки циклов, изменяющих размер шрифта.

1️⃣ Создайте пользовательскую форму.
2️⃣ Разместите код в модуле формы.

📌 Код VBA Excel

Option Explicit
'Объявляем переменную для создания метки
Private lblStroka As MSForms.Label
'Объявляем переменную для создания кнопки "Пуск" с поддержкой событий
Private WithEvents cmdPusk As MSForms.CommandButton

Private Sub cmdPusk_Click()
Dim i As Integer, Start As Single, Pause As Single
'Удаляющаяся строка
lblStroka.Caption = "Удаляющаяся строка"
    For i = 180 To 5 Step -1
        lblStroka.Font.Size = i / 5
        Start = Timer
        Pause = 0.02
            Do While Timer < Start + Pause
               DoEvents
            Loop
    Next
'Приближающаяся строка
lblStroka.Caption = "Приближающаяся строка"
    For i = 5 To 180 Step 1
        lblStroka.Font.Size = i / 5
        Start = Timer
        Pause = 0.02
            Do While Timer < Start + Pause
               DoEvents
            Loop
    Next
lblStroka.Caption = "Неподвижная строка"
End Sub

Private Sub UserForm_Initialize()
    With Me
        .Caption = "Удаляющаяся и приближающаяся строки"
        .Height = 200
        .Width = 500
        Set lblStroka = .Controls.Add("Forms.Label.1")
        Set cmdPusk = .Controls.Add("Forms.CommandButton.1")
    End With
    With lblStroka
        .Height = 50
        .Width = Me.Width
        .Top = 30
        .Left = 0
        .Font.Size = 36
        .TextAlign = fmTextAlignCenter
        .Caption = "Неподвижная строка"
    End With
    With cmdPusk
        .Caption = "Пуск"
        .Height = 28
        .Width = 80
        .Top = 120
        .Left = 216
        .Font.Size = 12
    End With
End Sub

3️⃣ Запустите форму, надпись и кнопка будут созданы автоматически.

#VBA #ExcelVBA #Строка #РазмерШрифта #Удаление #Приближение

✅ Сумма прописью для документов

У вас есть собственноручно созданные в Excel бухгалтерские или юридические документы? 📚 Вы хотите, чтобы в этих документах денежные суммы автоматически конвертировались в суммы прописью?

Скопируйте функцию СуммаПрописью и вставьте ее в Личную книгу макросов, чтобы функция была доступна для любого файла Excel на вашем компьютере.

🛠 Код пользовательской функции СуммаПрописью:

Public Function СуммаПрописью(x As Double) As String
If x > 999999999999.99 Then
СуммаПрописью = "Аргумент больше 999 999 999 999.99!"
ElseIf x < 0 Then
СуммаПрописью = "Аргумент отрицательный!"
Else
x = FormatNumber(x, 2)
Dim b As Byte, b1 As Byte, b2 As Byte, kop As String
b = (x - Fix(x)) * 100
b2 = b \ 10
b1 = b Mod 10
If b2 <> 1 And b1 = 1 Then
kop = " копейка"
ElseIf b2 <> 1 And b1 > 1 And b1 < 5 Then
kop = " копейки"
Else
kop = " копеек"
End If
kop = b2 & b1 & kop
Dim y(1 To 4) As Integer, i1 As Byte
For i1 = 1 To 4
x = Fix(x) / 1000
y(i1) = (x - Fix(x)) * 1000
Next
Dim Text(1 To 4) As String, i2 As Byte, y1 As Byte, y2 As Byte, _
y3 As Byte, Text0 As String, Text1 As String, Text2 As String, Text3 As String, _
Text4 As String
For i2 = 1 To 4
y1 = y(i2) Mod 10
y2 = (y(i2) - y1) / 10 Mod 10
y3 = y(i2) \ 100
Text1 = Choose(y3 + 1, "", "сто ", "двести ", "триста ", "четыреста ", _
"пятьсот ", "шестьсот ", "семьсот ", "восемьсот ", "девятьсот ")
Text2 = Choose(y2 + 1, "", "", "двадцать ", "тридцать ", "сорок ", _
"пятьдесят ", "шестьдесят ", "семьдесят ", "восемьдесят ", "девяносто ")
If y2 = 1 Then
Text3 = Choose(y1 + 1, "десять ", "одиннадцать ", "двенадцать ", _
"тринадцать ", "четырнадцать ", "пятнадцать ", "шестнадцать ", _
"семнадцать ", "восемнадцать ", "девятнадцать ")
ElseIf y2 <> 1 And i2 = 2 Then
Text3 = Choose(y1 + 1, "", "одна ", "две ", "три ", "четыре ", "пять ", _
"шесть ", "семь ", "восемь ", "девять ")
Else
Text3 = Choose(y1 + 1, "", "один ", "два ", "три ", "четыре ", "пять ", _
"шесть ", "семь ", "восемь ", "девять ")
End If
If y2 <> 1 And y1 = 1 Then
Text4 = Choose(i2, "рубль ", "тысяча ", "миллион ", "миллиард ")
ElseIf y2 <> 1 And y1 > 1 And y1 < 5 Then
Text4 = Choose(i2, "рубля ", "тысячи ", "миллиона ", "миллиарда ")
ElseIf y1 = 0 And y2 = 0 And y3 = 0 Then
Text4 = Choose(i2, "рублей ", "", "", "")
Else
Text4 = Choose(i2, "рублей ", "тысяч ", "миллионов ", "миллиардов ")
End If
Text(i2) = Text1 & Text2 & Text3 & Text4
Next
If y(1) + y(2) + y(3) + y(4) = 0 Then
Text0 = "ноль рублей " & kop
Else
Text0 = Text(4) & Text(3) & Text(2) & Text(1) & kop
End If
СуммаПрописью = Replace(Text0, Left(Text0, 1), UCase(Left(Text0, 1)), 1, 1)
End If
End Function

💡 Примечание
Пользовательская функция СуммаПрописью преобразует денежное значение из числовой формы до 12 целочисленных разрядов включительно в сумму прописью следующего формата: 0,00 = Ноль рублей 00 копеек.

#VBA #ExcelVBA #СуммаПрописью #Документ

✍️ Дата прописью для документов

При заполнении доверенностей, договоров, соглашений, решений, уставов и других юридических документов требуется указание дат прописью. Если вы заполняете эти документы в Excel, есть простое решение с помощью VBA - функция ДатаПрописью.

Скопируйте функцию ДатаПрописью и вставьте ее в Личную книгу макросов, чтобы функция была доступна для любого файла Excel на вашем компьютере.

🛠 Код пользовательской функции ДатаПрописью:

'Преобразование даты из числового формата в текст с 2001 по 2099 год
Public Function ДатаПрописью(md As Date) As String
If (md < 36892) Or (md > 73050) Then
ДатаПрописью = "Преобразуемая дата должна быть с 2001 по 2099 год!"
Else
Dim den As Byte, dg(1 To 4) As Byte, mes As Byte, god As Byte, _
mespr As String, dmgpr As String
den = Day(md)
mes = Month(md)
god = (Year(md) Mod 100)
dg(1) = god Mod 10
dg(2) = Fix(god / 10)
dg(3) = den Mod 10
dg(4) = Fix(den / 10)
Dim dgpr(1 To 4) As String, i1 As Byte
For i1 = 1 To 4
If (i1 = 1) Or (i1 = 3) Then
If dg(i1 + 1) = 1 Then
dgpr(i1) = Choose(dg(i1) + 1, "десятого ", "одиннадцатого ", "двенадцатого ", _
"тринадцатого ", "четырнадцатого ", "пятнадцатого ", "шестнадцатого ", _
"семнадцатого ", "восемнадцатого ", "девятнадцатого ")
Else
dgpr(i1) = Choose(dg(i1) + 1, "", "первого ", "второго ", _
"третьего ", "четвертого ", "пятого ", "шестого ", _
"седьмого ", "восьмого ", "девятого ")
End If
ElseIf (i1 = 2) Or (i1 = 4) Then
If dg(i1 - 1) = 0 Then
dgpr(i1) = Choose(dg(i1) + 1, "", "", "двадцатого ", _
"тридцатого ", "сорокового ", "пятидесятого ", "шестидесятого ", _
"семидесятого ", "восьмидесятого ", "девяностого ")
Else
dgpr(i1) = Choose(dg(i1) + 1, "", "", "двадцать ", _
"тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", _
"семьдесят ", "восемьдесят ", "девяносто ")
End If
End If
Next
mespr = Choose(mes, "января ", "февраля ", "марта ", "апреля ", "мая ", _
"июня ", "июля ", "августа ", "сентября ", "октября ", "ноября ", "декабря ")
dmgpr = dgpr(4) & dgpr(3) & mespr & "две тысячи " & dgpr(2) & dgpr(1) & "года"
ДатаПрописью = Replace(dmgpr, Left(dmgpr, 1), UCase(Left(dmgpr, 1)), 1, 1)
End If
End Function

💡 Функция ДатаПрописью преобразует даты из числового формата Excel в текст. Интервал преобразуемых дат: с 2001 по 2099 год.

#VBA #ExcelVBA #ДатаПрописью #Документ

📅 Вставка текущей даты в ячейки Excel

У меня уже был пост на эту тему, но дата вставлялась в активную ячейку в текстовом формате с текстовым выравниванием. После редактирования даты или просто после вставки курсора в ячейку, дата пересохранялась в числовом формате со сменой выравнивания на противоположное. Внешний вид столбца с датами получался - не очень. Я подправил код, чтобы дата сразу вставлялась в числовом формате. 🚀

📌 Код для вставки текущей даты в активную ячейку:

Sub InsertCurrentDate()
    ' Вставляем текущую дату в активную ячейку
    With ActiveCell
        .NumberFormat = "dd.mm.yyyy"
        .Value = Date
    End With
End Sub

1️⃣ Скопируйте процедуру InsertCurrentDate в стандартный модуль Личной книги макросов.
2️⃣ Перейдите из редактора VBA в Excel, сохраните текущую книгу и откройте окно "Макрос": Разработчик ➔ Макросы.
3️⃣ В списке макросов выберите процедуру PERSONAL.XLSB!InsertCurrentDate и нажмите кнопку "Параметры".
4️⃣ В поле "Сочетание клавиш:" впишите букву "й" (или другую свободную) и нажмите 🆗.
5️⃣ Сохраните текущую книгу и вставляйте текущую дату в ячейки Excel сочетанием клавиш Ctrl+й.

💡 Работа сочетания клавиш зависит от раскладки клавиатуры: если вы назначите - "й", будет работать только сочетание Ctrl+й, сочетание Ctrl+q работать не будет, и наоборот.

#VBA #ExcelVBA #Date #Ячейка #Дата #СочетаниеКлавиш

Изображение к посту "Курс валют"

💰 Курс валют

Проверил старую функцию на VBA Excel, возвращающую курс выбранной валюты в рублях. Оказалось, что она еще работает. 🚜

📌 Код функции

Function КурсВалют(Optional КодВалюты As String, Optional Дата As Date) As Double
    Dim myXml As Object, myDate As String
    Set myXml = CreateObject("msxml2.DOMDocument")
    If Not CBool(Len(КодВалюты)) Then КодВалюты = "USD"
    myDate = "?date_req=" & IIf(Дата, Дата, Date)
    myXml.async = 0: myXml.Load ("http://www.cbr.ru/scripts/XML_daily.asp" & myDate)
        With myXml.SelectSingleNode("*/Valute[CharCode='" & UCase(КодВалюты) & "']")
            КурсВалют = CDbl(.ChildNodes(4).Text) / Val(.ChildNodes(2).Text)
        End With
    Set myXml = Nothing
End Function

💡 Примечания
🔹 Параметры функции (КодВалюты и Дата) являются необязательными.
🔹 Если опустить параметр КодВалюты, будет применен код доллара.
🔹 Если опустить параметр Дата, будет применена текущая дата.
🔹 Если опустить оба параметра, будет возвращен курс доллара на текущую дату.

#VBA #ExcelVBA #КурсРубля #КурсДоллара #КурсЕвро #КурсЮаня

🖥 Вывод списка приложений

С помощью кода VBA Excel можно вывести список установленных на компьютере приложений. 💫

Код процедуры достаточно длинный 📋, и Телеграм не дает возможности опубликовать его в тексте поста ✖️. Но вы можете скопировать его с сайта «Время не ждёт» по этой ссылке.

#VBA #ExcelVBA #СписокПриложений #СписокПрограмм

📝 Запись значений диапазона в обычную переменную

Чтобы вывести на экран значения диапазона методом Debug.Print, необходимо записать эти значения в обычную строковую переменную (не массив). Но массив тоже будем использовать, так как циклы в массивах работают быстрее, чем в диапазонах ячеек.

📌 Пример кода

Sub Primer()
    Dim rng As Range, r&, c&, ar, i1&, i2&, txt$

    Set rng = Worksheets("Лист4").Range("A1:F40")

    With rng
        r = .Rows.Count
        c = .Columns.Count
        ar = .Value
    End With
    
    For i1 = 1 To r
        For i2 = 1 To c
            txt = txt & ar(i1, i2)
                If i2 = c Then
                    txt = txt & vbNewLine
                Else
                    txt = txt & "; "
                End If
        Next
    Next
       
    Debug.Print txt
End Sub

Отображение на экране будет построчным, как в исходном диапазоне. Элементы диапазона будут разделены друг от друга точкой с запятой и пробелом.

#VBA #ExcelVBA #Диапазон #Значение #Переменная #DebugPrint

📋 Выбор диапазона из таблицы

При ежедневном ведении базы данных (набора данных) в Excel таблица получается очень длинной. Она может содержать информацию о выручке по торговым точкам, о зарплатах сотрудников, о различных видах расходов и т.д. Анализировать такой набор данных и использовать его в целях учета приходится в разрезе интервалов дат, в соответствии с которыми необходимо осуществить выбор диапазона.

🛠 Функция для выбора диапазона

Function ВыборДиапазона(ИмяЛиста$, НачальнаяДата$, КонечнаяДата$) As Range
    Dim МассивДанных As Variant, i&, n1&, n2&, rws&, cls&
    
    'Отлавливаем всевозможные ошибки
    On Error GoTo ПриОшибке
 
    'Проверяем, чтобы начальная дата не превышала конечную
    If CDate(НачальнаяДата) > CDate(КонечнаяДата) Then
        MsgBox "Интервал дат задан неверно!"
        Exit Function
    End If
    
    With Worksheets(ИмяЛиста).Range("A1").CurrentRegion
        rws = .Rows.Count
        cls = .Columns.Count
        МассивДанных = .Value
    End With
    
    'Поиск начальной даты
    For i = 1 To rws
        If МассивДанных(i, 1) = НачальнаяДата Then
            n1 = i
            Exit For
        End If
    Next
    
    'Поиск конечной даты
    For i = rws To 1 Step -1
        If МассивДанных(i, 1) = КонечнаяДата Then
            n2 = i
            Exit For
        End If
    Next
    
    'Проверяем, что границы диапазона определены
    If n1 = 0 Or n2 = 0 Then
        MsgBox "Границы диапазона (или одна из границ) заданы неверно!"
        Exit Function
    End If
    
    Set ВыборДиапазона = Worksheets(ИмяЛиста).Range(Cells(n1, 1), Cells(n2, cls))
    Exit Function
    
ПриОшибке:
    MsgBox "Ошибка: " & Err.Description
End Function

💫 Пример выбора диапазона
Пример использования функции для выбора диапазона с использованием формы для ручного или автоматического заполнения интервала дат:

Private Sub CommandButton6_Click()
    Dim rng As Range
    
    'Отлавливаем ошибки
    On Error GoTo ПриОшибке
 
    Set rng = ВыборДиапазона("Лист4", TextBox1.Text, TextBox2.Text)
    
    If rng Is Nothing Then
        MsgBox "Диапазон не выбран!"
        Exit Sub
    End If
    
    'Строки кода для первоначального тестирования
    Dim r&, c&, ar, i1&, i2&, txt$
 
    With rng
        r = .Rows.Count
        c = .Columns.Count
        ar = .Value
    End With
    
    For i1 = 1 To r
        For i2 = 1 To c
            txt = txt & ar(i1, i2)
                If i2 = c Then
                    txt = txt & vbNewLine
                Else
                    txt = txt & "; "
                End If
        Next
    Next
    
    Debug.Print txt
    Exit Sub
    
ПриОшибке:
    MsgBox "Ошибка: " & Err.Description
End Sub

💡 Примечания
1️⃣ Формат дат, загружаемых в функцию, должен соответствовать формату дат в наборе данных.
2️⃣ Код VBA Excel для первоначального тестирования отображает на экране (в окне Immediate) содержимое ячеек выбранного диапазона. Отображаются значения построчно, как в исходном диапазоне, с разделением друг от друга точкой с запятой и пробелом.
3️⃣ Обратите внимание, что в окне Immediate умещается ограниченное количество знаков — если диапазон большой, все значения могут не поместиться.
4️⃣ После удачного тестирования, строки кода для первоначального тестирования заменяются на строки кода для обработки выбранного диапазона.

#VBA #ExcelVBA #Выбор #Диапазон #Таблица

Необязательные параметры в VBA Excel

Оказывается, для необязательных параметров процедур в VBA и VB есть определенные правила, сформулированные разработчиками:

1️⃣ Для каждого необязательного параметра в определении процедуры необходимо указать значение по умолчанию.
2️⃣ Значение по умолчанию для необязательного параметра должно быть константой или выражением константы.
3️⃣ В определении процедуры сначала указываются обязательные параметры, а затем — необязательные. Параметр, следующий за необязательным параметром, должен быть необязательным.

Пример указания необязательных параметров:

Sub Primer(Parametr1, Parametr2, Optional Parametr3, Optional Parametr4)
'    Код процедуры
End Sub

Для тех, кто только что присоединился к нашему каналу, продублирую примеры указания значений по умолчанию для необязательного параметра функции, вычисляющей площадь квадрата.

🔹 Указание значения по умолчанию в определении функции:

Function SquareNumbers(Optional d = 1.2)
    SquareNumbers = d * d
End Function

🔹 Указание значения по умолчанию с помощью функции IsMissing:

Function SquareNumbers(Optional d)
    If IsMissing(d) Then d = 1.2
    SquareNumbers = d * d
End Function

Функция IsMissing работает только с типом данных Variant.

#VBA #ExcelVBA #Optional #IsMissing #Параметры #Необязательные

Номер последней заполненной строки
Два способа найти номер последней заполненной строки любой таблицы на листе Excel. Для поиска последней строки будем отталкиваться от ее верхней левой ячейки: Cells(a, b). Соответственно, если верхняя левая ячейка A1, тогда Cells(1, 1).

1️⃣ Первый способ
Основная формула для поиска номера последней строки (PosStr) в любой таблице, не требующая соблюдения каких-либо условий:

PosStr = Cells(a, b).CurrentRegion.Cells(Cells(a, b).CurrentRegion.Cells.Count).Row

2️⃣ Второй способ
Дополнительная формула с условием, что в первом столбце таблицы нет пустых ячеек:

PosStr = Cells(a, b).End(xlDown).Row

#VBA #ExcelVBA #Номер #Строка #Таблица #Последняя

🔥 Вставка популярных символов в ячейки Excel

Быстрая вставка популярных символов в ячейки Excel (а также в Word, Блокнот) осуществляется с помощью левой клавиши Alt + [код символа]. ✨

Код символа набирается на цифровом блоке клавиатуры ⌨️ (в правой ее части). Применение сочетания клавиш удобнее, чем вызов Таблицы символов.

Мне чаще всего приходится использовать Alt-коды для ввода кавычек-ёлочек (кроме Word, конечно), знаков градуса и рубля:
Alt + [0171] → [«];
Alt + [0187] → [»];
Alt + [0176] → [°];
Правый Alt + [8] → [₽] (здесь 8 нажимается в строке над буквенным блоком клавиатуры).

Alt-коды других популярных символов в таблице ниже.

#VBA #Excel #Символ #Вставка #Alt #Код

Ещё больше Alt-кодов я опубликовал на своём сайте в статье Таблица символов и Alt-коды.

📋 Элемент управления ListView
ListView (вид списка, представление списка) — элемент управления, который позволяет отображать данные в виде значков, списка или таблицы внутри формы VBA Excel. Чаще всего ListView используется для отображения данных в виде таблицы - режим Отчет (lvwReport).

🎈 Добавление ListView на UserForm
1️⃣ Откройте редактор VBA (Alt + F11).
2️⃣ В редакторе VBA выберите Tools → References.
3️⃣ Найдите и активируйте библиотеку Microsoft Windows Common Controls, если она ещё не активирована.
4️⃣ Создайте новую форму (Insert → UserForm).
5️⃣ Если панели элементов управления не видно, откройте ее (View → Toolbox).
6️⃣ Щелкните правой кнопкой мыши на панели элементов управления и выберите «Additional Controls…» (Дополнительные элементы управления…).
7️⃣ Найдите «Microsoft ListView Control» и добавьте его на панель.
8️⃣ Перетащите элемент ListView с панели элементов на вашу UserForm.

📌 Пример заполнения ListView
Пример отображения списка сотрудников с их ФИО, должностью и отделом:

Private Sub UserForm_Initialize()
    ' Настройка формы
    With Me
        .Caption = "Список сотрудников"
        .Width = 300
        .Height = 160
    End With
 
    With Me.ListView1
        ' Настройка режима отображения
        .View = lvwReport
        .Gridlines = True
        .FullRowSelect = True
        .Left = Me.Left
        .Top = Me.Top
        .Width = Me.Width ' По ширине разворачиваем на всю форму
        .Height = Me.Height - 70 ' Внизу оставляем место для кнопок
        
        ' Добавляем колонки с заголовками и задаем ширину
        .ColumnHeaders.Add , , "ID", 30 ' Заголовок 1, но столбец 0
        .ColumnHeaders.Add , , "ФИО", 80 ' Заголовок 2, но столбец 1
        .ColumnHeaders.Add , , "Должность", 80 ' Заголовок 3, но столбец 2
        .ColumnHeaders.Add , , "Отдел", 105 ' Заголовок 4, но столбец 3
        
        ' Добавляем строки
        Dim itm As ListItem
        
        Set itm = .ListItems.Add(, , "1") ' Элемент 1 строки (0 столбец)
        itm.SubItems(1) = "Иванов И.И."   ' Подэлемент 1 строки (1 столбец)
        itm.SubItems(2) = "Менеджер"      ' Подэлемент 1 строки (2 столбец)
        itm.SubItems(3) = "Отдел продаж"  ' Подэлемент 1 строки (3 столбец)
        
        Set itm = .ListItems.Add(, , "2")
        itm.SubItems(1) = "Петров П.П."
        itm.SubItems(2) = "Аналитик"
        itm.SubItems(3) = "Финансовый отдел"
        
        Set itm = .ListItems.Add(, , "3")
        itm.SubItems(1) = "Сидоров С.С."
        itm.SubItems(2) = "Программист"
        itm.SubItems(3) = "ИТ-отдел"
    End With
End Sub

Вставьте код примера в модуль UserForm. Результат работы кода представлен на изображении ниже.

#VBA #Excel #ListView #Отчет #Report

Изображение к посту выше.

🔢 Сортировка данных в ListView

Чтобы сортировать данные в табличных отчетах ListView, добавьте следующий код VBA Excel в модуль формы:

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    With Me.ListView1
        .Sorted = True
        .SortKey = ColumnHeader.SubItemIndex  ' Сортировка по выбранному столбцу
        .SortOrder = IIf(.SortOrder = 1, 0, 1)  ' Переключение порядка сортировки
    End With
End Sub

Теперь при клике по заголовку любого столбца произойдет сортировка строк по данным этого столбца. При первом клике будет порядок сортировки — по убыванию, при втором — по возрастанию, при третьем — снова по убыванию и так далее.

💡 Небольшое пояснение для поста выше:
В таблицах ListView нумерация столбцов начинается с 0 (ColumnHeader.SubItemIndex), а нумерация заголовков столбцов - с 1 (ColumnHeader.Index).

#VBA #Excel #ListView #Сортировка #Sort #ColumnHeader

Доступ к данным в таблице ListView
Вывод данных из выделенной строки в таблице ListView с помощью кода VBA Excel на примере таблицы со скриншота выше.

Добавьте на форму с ListView элемент управления CommandButton1 (кнопка) и в модуль формы вставьте следующий код:

Private Sub CommandButton1_Click()
Dim sItem As ListItem
Set sItem = ListView1.selectedItem
    If Not sItem Is Nothing Then
        MsgBox "Выбрана строка:" & vbNewLine & _
            "ID = " & sItem.Text & vbNewLine & _
            "ФИО = " & sItem.ListSubItems(1).Text & vbNewLine & _
            "Должность = " & sItem.ListSubItems(2).Text & vbNewLine & _
            "Отдел = " & sItem.ListSubItems(3).Text
    Else
        MsgBox "Строка не выбрана!"
    End If
End Sub

Откройте форму с ListView, выберите строку и нажмите кнопку CommandButton1. Информационное окно MsgBox отобразит данные из выделенной строки.

#VBA #Excel #ListView #Данные #Вывод

📋 ListView в режиме lvwSmallIcon
ListView в режиме lvwSmallIcon - это более удачный вариант, чем ListView в режиме lvwIcon. По крайней мере, на моём программном обеспечении.

Пример использования ListView в режиме lvwSmallIcon
1️⃣ Подключите библиотеку Microsoft Windows Common Controls 6.0 (SP6), если она не подключена.
2️⃣ Добавьте на панель Toolbox элементы управления «Microsoft ListView Control» и «Microsoft ImageList Control».
3️⃣ Создайте новую форму и перетащите на неё элементы ListView, ImageList и CommandButton с панели элементов управления (Toolbox).
4️⃣ Создайте несколько иконок (в примере их 5 штук) и поместите их в папку с именем «Test» на диске «C».
5️⃣ В модуль формы вставьте следующий код:

Private Sub UserForm_Initialize()
    ' Настройка формы
    With Me
        .Caption = "Сообщество смурфов"
        .Width = 350
        .Height = 250
    End With
    
    ' Настройка кнопки
    With CommandButton1
        .Caption = "Выбрать"
        .Width = 60
        .Height = 24
        .Top = Me.Height - 70
        .Left = Me.Width / 3 + 20
        .Font.Size = 10
    End With
    
    ' Настройка ListView
    With ListView1
        .View = lvwSmallIcon
        .LabelEdit = lvwManual
        .Sorted = True
        .MultiSelect = False
        .HideSelection = False
        .FullRowSelect = False
        .Left = Me.Left
        .Top = Me.Top
        .Width = Me.Width ' По ширине разворачиваем на всю форму
        .Height = Me.Height - 80 ' Внизу оставляем место для кнопок
    End With
 
    With ImageList1.ListImages
        .Add , "PapaSmurf", LoadPicture("C:\Test\PapaSmurf.ico")
        .Add , "Smurfette", LoadPicture("C:\Test\Smurfette.ico")
        .Add , "BrainySmurf", LoadPicture("C:\Test\BrainySmurf.ico")
        .Add , "GutsySmurf", LoadPicture("C:\Test\GutsySmurf.ico")
        .Add , "ClumsySmurf", LoadPicture("C:\Test\ClumsySmurf.ico")
    End With
 
    ' Привязка ImageList к ListView
    Set ListView1.SmallIcons = ImageList1
 
    ' Добавление элементов с иконками
    With ListView1.ListItems
        .Add , , "Папа Смурф", , "PapaSmurf"
        .Add , , "Смурфетта", , "Smurfette"
        .Add , , "Смурф Знайка", , "BrainySmurf"
        .Add , , "Смурф Храбрец", , "GutsySmurf"
        .Add , , "Смурф Растяпа", , "ClumsySmurf"
    End With
End Sub

Запустите форму, нажав на треугольник (Run Sub/UserForm) или на клавишу F5. Результат работы кода на скриншоте ниже.

#VBA #Excel #ListView #Icon #Значок #Иконка