✏️ Модификатор 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 #Значок #Иконка