Использование галочки в ячейке Excel в качестве переключателя.

✅ Выбор позиции в списке

Вставка галочки в ячейке слева от выбранной позиции из списка с очисткой предыдущего выбора.

📌 Код VBA Excel

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    'Проверяем, что выбрана одна ячейка
    If Target.Cells.Count > 1 Then Exit Sub
    
    'Задаем диапазон для вставки галочки
    Dim rng As Range
    Set rng = [A1:A5]

    'Проверяем, входит ли выбранная ячейка в указанный диапазон
    If Not Intersect(Target, rng) Is Nothing Then
        rng.ClearContents 'Очищаем диапазон от старой галочки
        Target.Value = ChrW(10004) 'Вставляем галочку в выбранную ячейку
    End If
End Sub

💡 Примечания
🔹 Код размещается в модуле листа.
🔹 Функция ChrW возвращает символы Unicode
🔹 ChrW(10004) возвращает галочку.
🔹 Проверено в Excel 2016.

#VBA #ExcelVBA #Выбор #Позиция #Галочка

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

Вставляем текущую дату в заданном формате в ячейки Excel сочетанием клавиш. 🚀

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

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

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

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

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

✏️ Редактирование текста в ячейке из кода VBA
Программное редактирование текста в ячейке с помощью VBA Excel.

📌 Примеры

1️⃣ Добавление текста в начало строки с заменой первой буквы:

Sub Primer1()
Dim obj As Object
    Range("A1") = "Короткий текст"
    'Превращаем "Короткий текст" в "Очень короткий текст"
    Range("A1").Characters(1, 1).Insert ("Очень к")
End Sub

💡 В Characters(1, 1) первая цифра означает, что "курсор" ставится перед первым знаком текста в ячейке, в вторая цифра означает, что выбирается один знак после точки вставки ("курсора"), который будет замещен вставляемой строкой.

2️⃣ Добавление текста в середину строки перед 9 знаком:

Sub Primer2()
Dim obj As Object
    Range("A1") = "Короткий текст"
    Range("A1").Characters(9, 0).Insert (", но не очень,")
End Sub

💡 В Characters(9, 0) первая цифра означает, что "курсор" ставится перед 9 знаком текста в ячейке, в вторая цифра означает, что дополнительный текст будет вставлен, начиная с точки вставки, без замещения каких-либо знаков существующей строки.

#VBA #ExcelVBA #Range #Characters #Ячейка #Редактирование

🚀 Создание и распаковка ZIP-архива с помощью VBA Excel

С помощью VBA можно легко создавать ZIP-архивы и распаковывать их без сторонних программ.

📦 Создание ZIP-архива:

Sub CreateZipArchive()
    Dim oShell As New Shell32.Shell
    Dim oSourceFolder As Shell32.Folder
    Dim oZipFolder As Shell32.Folder
    Dim sourceFolder As String
    Dim zipFile As String
    Dim startTime As Double
    Dim timeoutSeconds As Double
    
    ' Укажите свои пути
    sourceFolder = "C:\Test\Лагенария\"
    zipFile = "C:\Test\Лагенария.zip"
    
    ' Проверка исходной папки
    Set oSourceFolder = oShell.Namespace(sourceFolder)
    If oSourceFolder Is Nothing Then
        MsgBox "Исходная папка '" & sourceFolder & "' не найдена или недоступна!", vbExclamation
        Exit Sub
    End If
    
    ' Создаем архив
    On Error Resume Next
    If Dir(zipFile) = "" Then
        CreateObject("Scripting.FileSystemObject").CreateTextFile(zipFile).Write "PK" & Chr(5) & Chr(6) & String(18, vbNullChar)
        If Err.Number <> 0 Then
            MsgBox "Ошибка при создании ZIP-файла: " & Err.Description, vbCritical
            Exit Sub
        End If
    End If
    On Error GoTo 0
    
    ' Проверка ZIP-файла
    Set oZipFolder = oShell.Namespace(zipFile)
    If oZipFolder Is Nothing Then
        MsgBox "Не удалось создать или открыть ZIP-архив!", vbCritical
        Exit Sub
    End If
    
    ' Добавляем файлы
    oZipFolder.CopyHere oSourceFolder.Items
    
    ' Ждем завершения с тайм-аутом
    startTime = Timer
    timeoutSeconds = 30
    Do Until oZipFolder.Items.Count = oSourceFolder.Items.Count
        Application.Wait (Now + TimeValue("0:00:01"))
        If Timer - startTime > timeoutSeconds Then
            MsgBox "Тайм-аут: процесс архивации не завершился за " & timeoutSeconds & " секунд.", vbExclamation
            Exit Sub
        End If
    Loop
    
    MsgBox "ZIP-архив успешно создан! (" & oZipFolder.Items.Count & " элементов)", vbInformation
End Sub

🛠 Настройка:
1️⃣ Откройте VBA Editor (Alt + F11).
2️⃣ Перейдите в Tools → References.
3️⃣ Подключите библиотеку Microsoft Shell Controls And Automation.
4️⃣ Замените пути на свои и протестируйте код.

💡 Примечания
🔹 Код может быть значительно короче, но данный код учитывает больше возможных ошибок.
🔹 Для объектов Shell используется ранняя привязка (для этого потребовалось подключить библиотеку Microsoft Shell Controls And Automation) — мне не удалось заставить его работать с поздней привязкой на своем компьютере.

#VBA #ExcelVBA #ZIP #Архив #Создание

📂 Распаковка ZIP-архива:

Sub ExtractZipArchive()
    Dim oShell As Shell32.Shell
    Dim oZipFolder As Shell32.Folder
    Dim oExtractFolder As Shell32.Folder
    Dim zipFile As String
    Dim extractPath As String
    Dim startTime As Double
    Dim timeoutSeconds As Double
    
    ' Указываем пути
    zipFile = "C:\Test\Лагенария.zip"
    extractPath = "C:\Test\ЛагенарияКопия\"
    
    ' Инициализация Shell
    Set oShell = New Shell32.Shell
    
    ' Проверка существования архива
    If Dir(zipFile) = "" Then
        MsgBox "Архив '" & zipFile & "' не найден!", vbExclamation
        Exit Sub
    End If
    
    ' Проверка существования папки для распаковки, создание, если не существует
    On Error Resume Next
    If Dir(extractPath, vbDirectory) = "" Then
        MkDir extractPath
        If Err.Number <> 0 Then
            MsgBox "Не удалось создать папку для распаковки: " & Err.Description, vbCritical
            Exit Sub
        End If
    End If
    On Error GoTo 0
    
    ' Устанавливаем объекты
    Set oZipFolder = oShell.Namespace(zipFile)
    If oZipFolder Is Nothing Then
        MsgBox "Не удалось открыть ZIP-архив!", vbCritical
        Exit Sub
    End If
    
    Set oExtractFolder = oShell.Namespace(extractPath)
    If oExtractFolder Is Nothing Then
        MsgBox "Не удалось открыть папку для распаковки!", vbCritical
        Exit Sub
    End If
    
    ' Извлекаем содержимое
    oExtractFolder.CopyHere oZipFolder.Items
    
    ' Ждем завершения с тайм-аутом
    startTime = Timer
    timeoutSeconds = 30
    Do Until oExtractFolder.Items.Count = oZipFolder.Items.Count
        Application.Wait (Now + TimeValue("0:00:01"))
        If Timer - startTime > timeoutSeconds Then
            MsgBox "Тайм-аут: процесс распаковки не завершился за " & timeoutSeconds & " секунд.", vbExclamation
            Exit Sub
        End If
    Loop
    
    MsgBox "Архив успешно распакован! (" & oExtractFolder.Items.Count & " элементов)", vbInformation
End Sub

#VBA #ExcelVBA #ZIP #Архив #Распаковка

🖥 Форма на весь экран в VBA Excel
Хотите, чтобы UserForm автоматически разворачивалась на весь экран при открытии? Это можно сделать двумя простыми способами! 🚀

1️⃣ Пример с Application
Этот способ использует свойства Application для установки ширины и высоты формы.

Private Sub UserForm_Initialize()
    With Application
        .DisplayFullScreen = True 'Включаем полноэкранный режим
            Me.Width = .Width 'Устанавливаем ширину формы
            Me.Height = .Height 'Устанавливаем высоту формы
        .DisplayFullScreen = False 'Отключаем полноэкранный режим
    End With
End Sub

Плюсы:
✔️ Простая реализация без подгонки каких-либо коэффициентов.
✔️ Работает при любом разрешении и масштабировании экрана.
Минусы:
✖️ Мелькания программы Excel на экране при разворачивании и сворачивании.
✖️ В старых версиях Excel может не работать Application.DisplayFullScreen = True, но там можно попробовать Application.WindowState = xlMaximized.

2️⃣ Пример с WinAPI
Этот способ использует функцию API Windows для точного определения системных размеров экрана.

'Функция WinAPI размещается в стандартном модуле, в модуле формы она работать не будет
Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

'Эта процедура размещается в модуле формы
Private Sub UserForm_Initialize()
Dim k As Single
k = 1.99
    With Me
        .Width = GetSystemMetrics(0) / k 'Получаем ширину экрана
        .Height = GetSystemMetrics(1) / k 'Получаем высоту экрана
    End With
End Sub

Плюсы:
✔️ Отсутствие мельканий программы Excel на экране.
Минусы:
✖️ Требует использование функции WinAPI и применение коэффициента для подгонки размера формы под конкретный дисплей.

💡 Коэффициент необходим, чтобы учесть масштабирование экрана, которое часто установлено на 125%, 150% или выше. Возможно, что-то еще влияет, кроме масштабирования. У меня масштабирование - 150%, но форма разворачивается на весь экран при k = 1.99, а не при k = 1.5.

#VBA #ExcelVBA #Масштабирование #Форма #Экран

🔥 Функциональные клавиши в Excel (F1–F12) и полезные сочетания

Использование функциональных клавиш (F1–F12) — это способ ускорить выполнение в Excel различных задач. Функциональные клавиши работают как самостоятельно, так и в сочетании с другими клавишами (Alt, Ctrl, Shift).

✨ Функции клавиш F1–F12

🔹 F1 – Открывает справку Excel.
🔹 F2 – Редактирует активную ячейку (курсор перемещается в строку формул).
🔹 F3 – Отображает диалоговое окно "Вставка имени" (если имена определены).
🔹 F4 – Переключает в формулах тип ссылок ($A$1 → A$1 → $A1 → A1).
🔹 F5 – Открывает окно "Перейти" для быстрого перехода к ячейке или диапазону.
🔹 F6 – Переключает фокус между панелями (лист, строка формул, панель вкладок).
🔹 F7 – Запускает проверку орфографии.
🔹 F8 – Включает режим выделения (позволяет расширять выделение стрелками).
🔹 F9 – Пересчитывает все формулы в книге (полезно при ручном режиме расчета).
🔹 F10 – Активирует меню (аналог Alt).
🔹 F11 – Создает новый график на отдельном листе из выделенного диапазона.
🔹 F12 – Открывает окно "Сохранить как".

💫 Полезные сочетания с функциональными клавишами

🔹 Ctrl + F1 – Сворачивает/разворачивает ленту (Ribbon).
🔹 Ctrl + F2 – Открывает окно предварительного просмотра перед печатью.
🔹 Ctrl + F3 – Открывает диспетчер имен для управления именованными диапазонами.
🔹 Ctrl + F4 – Закрывает текущую книгу, не выходя из Excel.
🔹 Ctrl + F6 – Переключается между открытыми книгами Excel.
🔹 Ctrl + F9 – Сворачивает окно текущей книги в значок на панели задач.
🔹 Ctrl + F10 – Разворачивает/сворачивает окно текущей книги.
🔹 Alt + F4 – Закрывает Excel полностью.
🔹 Alt + F11 – Открывает редактор VBA для написания макросов.
🔹 Shift + F2 – Добавляет или редактирует примечание к ячейке.
🔹 Shift + F3 – Открывает окно "Вставка функции" (помощник для формул).
🔹 Shift + F5 – Запускает поиск (аналог Ctrl + F).
🔹 Shift + F11 – Добавляет новый лист в книгу.

💡 Если функциональные клавиши не работают, проверьте, не включен ли режим Fn Lock на вашей клавиатуре (особенно на ноутбуках).

#Excel #Горячие #Функциональные #Клавиши #Сочетания

🎁 Поздравление-сюрприз от VBA Excel

Хотите оригинально поздравить с каким-нибудь праздником коллегу по работе? 🎈 Это можно организовать с помощью VBA Excel. 🚀

✨ Как это работает?

Поздравляемый включает свой компьютер, на котором после загрузки Windows, из папки "Автозагрузка" открывается файл Excel с поздравлением (форма с поздравлением разворачивается на весь экран). 🖥

🛠 Что для этого нужно?

1️⃣ Создайте файл Excel с поддержкой макросов.
2️⃣ Сохраните его в папку "Автозагрузка". Обычно, путь к ней таков: C:\Users\user\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Startup.
3️⃣ Откройте редактор VBA, создайте пользовательскую форму и добавьте на нее три элемента Label.
4️⃣ Вставьте в модули книги и формы следующие процедуры:

' В модуль книги
Private Sub Workbook_Open()
    UserForm1.Show
End Sub

'В модуль формы
Private Sub UserForm_Initialize()
Dim colForm&, colTxt&, c1$, c2$, c3$
    colForm = RGB(0, 0, 255) 'Цвет формы (синий)
    colTxt = RGB(255, 255, 255) 'Цвет текста (белый)
    c1 = "Привет!" 'Заголовок
    c2 = "Поздравляю с Днем рождения!!!" 'Поздравление
    c3 = "Твой Комп" 'Подпись
    
        With Application
            .DisplayFullScreen = True
                Me.Width = .Width
                Me.Height = .Height
            .DisplayFullScreen = False
        End With
        
        With Me
            .Caption = ""
            .BackColor = colForm
        End With
        
        With Label1
            .Caption = c1
            .BackColor = colForm
            .TextAlign = fmTextAlignCenter
            .Font.Size = 40
            .ForeColor = colTxt
            .Width = Me.Width
            .Height = 50
            .Top = Me.Height / 3
            .Left = 0
        End With
        
        With Label2
            .Caption = c2
            .BackColor = colForm
            .TextAlign = fmTextAlignCenter
            .Font.Size = 50
            .ForeColor = colTxt
            .Width = Me.Width
            .Height = 60
            .Top = Me.Height / 2.4
            .Left = 0
        End With
        
        With Label3
            .Caption = c3
            .BackColor = colForm
            .TextAlign = fmTextAlignCenter
            .Font.Size = 30
            .ForeColor = colTxt
            .Width = Me.Width
            .Height = 40
            .Top = Me.Height / 1.8
            .Left = 0
        End With
End Sub

5️⃣ Сохраните книгу.

💡 Примечания
🔹 Каждому элементу Label можно задать свой размер и цвет текста.
🔹 Другие варианты разворачивания формы на весь экран, если вдруг не получится с этим кодом, можно посмотреть здесь.

#VBA #ExcelVBA #UserForm #Форма #Поздравление

🔄 Работа с буфером обмена в VBA Excel

✖️ До Windows 8 в VBA Excel работали с буфером обмена через объект DataObject. Но в Windows 8 метод DataObject.PutInClipboard не работает правильно: если открыт хотя бы один экземпляр Проводника (папка), в буфер обмена записываются два квадратика. ◽️◽️☹️

В Windows 10 метод DataObject.PutInClipboard я не проверял, а в Windows 11 он работает корректно. Как работать с буфером обмена через DataObject смотрите на сайте. 🚀

🔥 Для работы с буфером обмена можно использовать следующие функции:

'Функция записи текста в буфер обмена
Function SetClipBoardText(ByVal Text As Variant) As Boolean
    SetClipBoardText = CreateObject("htmlfile").parentWindow.clipboardData.SetData("Text", Text)
End Function
 
'Функция вставки текста из буфера обмена
Function GetClipBoardText() As String
    On Error Resume Next
    GetClipBoardText = CreateObject("htmlfile").parentWindow.clipboardData.GetData("Text")
End Function
 
'Функция очистки буфера обмена
Function ClearClipBoardText() As Boolean
    ClearClipBoardText = CreateObject("htmlfile").parentWindow.clipboardData.clearData("Text")
End Function

📌 Пример:

Sub Primer()
Dim s As String
    s = "Копирование текста из переменной в буфер обмена"
    'Копируем текст в буфер обмена
    SetClipBoardText (s)
    'Вставляем текс из буфера обмена в ячейку "A1"
    Range("A1") = GetClipBoardText
    'Очищаем буфер обмена, если это необходимо
    ClearClipBoardText
End Sub

💡 Ячейки и диапазоны ячеек копируем и вставляем по-старинке:

Sub RangeCopyPaste()
    'Копирование диапазона ячеек в буфер обмена
    Range("A1:F5").Copy
    'Вставка диапазона из буфера обмена на рабочий лист
    ActiveSheet.Paste Range("A7")
    'Очистка буфера обмена
    Application.CutCopyMode = False
End Sub

#VBA #ExcelVBA #ClipBoard #Range #БуферОбмена #Диапазон

🎯 Расположение формы в окне Excel

Если при работе в Excel часто приходится обращаться к какой-либо форме, например с кнопками вызова макросов и/или открытия файлов, ее можно отобразить в немодальном окне. А для того, чтобы открытая форма не мешалась перед глазами, ее можно закрепить на постоянное место в окне рабочей книги. 📌

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

🛠 Как это работает?
🔹 При открытии книги, если активным является "Лист1", форма автоматически загружается и размещается в правом верхнем углу.
🔹 В открытой книге: при выборе листа "Лист1" - форма отображается, при выборе любого другого листа - форма закрывается.
🔹 При изменении размеров окна активной книги открытая форма будет перемещаться вслед за правым верхнем углом.

1️⃣ В стандартный модуль:

Sub UserFormPosition()
    With UserForm1
        'Задаем расположение формы (в правом верхнем углу)
        .Top = ActiveWindow.Top + 40
        .Left = ActiveWindow.Left + ActiveWindow.Width - .Width - 20
    End With
End Sub

🔸 Числовые коэффициенты отодвигают форму от краев окна. Сверху - чтобы не были закрыты кнопки управления окном приложения, а справа - просто так, для лучшего вида.

2️⃣ В модуль листа "Лист1":

'Загружаем форму при активации листа "Лист1"
Private Sub Worksheet_Activate()
    UserForm1.Show 0
    Call UserFormPosition
End Sub

'Выгружаем форму при деактивации листа "Лист1"
Private Sub Worksheet_Deactivate()
    Unload UserForm1
End Sub

3️⃣ В модуль книги:

'Загружаем форму при открытии книги, если нужно
Private Sub Workbook_Open()
    If ActiveSheet.Name = "Лист1" Then
        UserForm1.Show 0
        Call UserFormPosition
    End If
End Sub

'Перемещаем форму при изменении размеров окна Excel
Private Sub Workbook_WindowResize(ByVal Wn As Window)
    Call UserFormPosition
End Sub

💡 Примечания
🔹 При перемещении окна Книги в пределах экрана вручную, форма будет оставаться неподвижной. Чтобы вернуть ее в свой правый верхний угол, достаточно выбрать другой лист и вернуться на "Лист1".
🔹 Проверено в Excel 2016. Я работал с такой формой в Excel 2000, но там устанавливал расположение вручную, выбрав в свойствах формы: StartupPosition = 0 - Manual.

#VBA #ExcelVBA #Форма #Положение #Расположение

✨ Парсинг содержимого тегов с сайта в VBA Excel

Парсинг содержимого тегов со страницы сайта с помощью кода VBA Excel на примере тега <h2>. Теги <h2> обычно содержат основные заголовки в тексте статьи. Пошаговая инструкция, как это сделать:

Шаг 1: Подготовка среды
Перед началом работы нужно подключить необходимые библиотеки:
1. Откройте редактор VBA, нажав Alt + F11.
2. Перейдите в меню Tools → References.
3. Поставьте галочки напротив:
- Microsoft HTML Object Library (для работы с HTML).
- Microsoft XML, v6.0 (для отправки HTTP-запросов).
4. Нажмите OK.

Шаг 2: Код для парсинга
Ниже приведен готовый код, который отправляет запрос к сайту, извлекает содержимое тегов <h2> и записывает его в ячейки Excel:

Sub ParseTags()
    Dim http As Object
    Dim html As New HTMLDocument
    Dim tagElements As Object
    Dim tag As Object
    Dim url As String
    Dim i As Integer
    
    ' Укажите нужный URL страницы
    url = "https://internettovary.ru/avtomoyka-akkumulyatornaya/"
    
    ' Создаем объект для HTTP-запроса
    Set http = CreateObject("MSXML2.XMLHTTP")
    
    ' Отправляем GET-запрос
    http.Open "GET", url, False
    http.send
    
    ' Проверяем успешность запроса
    If http.Status = 200 Then
        ' Загружаем HTML в объект HTMLDocument
        html.body.innerHTML = http.responseText
        
        ' Находим все теги <h2>
        Set tagElements = html.getElementsByTagName("h2")
        ' Выводим содержимое тегов <h2> в ячейки Excel
        i = 1
        For Each tag In tagElements
            Cells(i, 1).Value = tag.innerText
            i = i + 1
        Next tag
    Else
        MsgBox "Ошибка при получении страницы: " & http.Status
    End If
    
    ' Очистка
    Set http = Nothing
    Set html = Nothing
End Sub

🛠 Как это работает

1. Инициализация:
🔹 Объект http создается для отправки запроса.
🔹 Объект html используется для парсинга HTML-кода.
2. Запрос к странице:
🔹 Указываем URL сайта в переменной url.
🔹 Отправляем GET-запрос с помощью http.send.
3. Парсинг данных:
🔹 Если запрос успешен (код состояния 200), HTML-код загружается в html.body.innerHTML.
🔹 Метод getElementsByTagName("h2") находит все теги <h2> на странице.
4. Вывод в Excel:
🔹 Содержимое каждого тега <h2> (через innerText) записывается в столбец A, начиная с первой строки.
5. Обработка ошибок:
🔹 Если страница не загрузилась, выводится сообщение с кодом ошибки.

💡 Примечания
🔹 Если теги <h2> формируются JavaScript’ом, этот метод не сработает, так как XMLHTTP видит только исходный HTML.
🔹 При проблемах с отображением символов может потребоваться дополнительная перекодировка текста (у меня проблем с кодировкой URL-страницы из примера не было).
🔹 Чтобы спарсить содержимое других тегов, в выражении Set tagElements = html.getElementsByTagName("h2") замените тег "h2" на любой другой, например: "ul", "ol", "p", "a", "span".

Попробуйте этот код, чтобы быстро собрать заголовки <h2> с сайта прямо в Excel! 🚀

#VBA #ExcelVBA #Парсинг #Автоматизация

Пользовательские функции
Дата прописью в Excel
Денежная сумма прописью
Значение параметра функции по умолчанию
Курс валют
Синтаксис пользовательской функции
Функции для работы с буфером обмена
Функции для сортировки массива

#VBA #Excel #Функция #Пользовательская

📃 Список изменений на листе Excel

Допустим, у вас есть таблица или набор данных на листе Excel, которые нельзя редактировать без вашего ведома. 📋 Но как отследить изменения, внесенные случайно или намеренно посторонними? Или нужно вспомнить свои корректировки?

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

📌 Что для этого нужно?
1️⃣ Создайте новый лист Excel с именем ярлыка - "СписокИзменений".
2️⃣ На листе "СписокИзменений" в ячейки A1, B1 и C1 впишите заголовки столбцов таблицы: Дата и время, Адрес ячейки и Новое значение.
3️⃣ Код процедуры, представленный ниже, разместите в модуле листа, на котором необходимо отслеживать изменения.

📆 Код для отслеживания изменений:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, UsedRange) Is Nothing Then
        Application.ScreenUpdating = False
            Dim n As Integer
            With Worksheets("СписокИзменений")
                'Отображаем лист для новой записи
                .Visible = True
                'Определяем номер первой пустой строки
                n = .Range("A1").CurrentRegion.Rows.Count + 1
                'Записываем дату и время редактирования
                .Cells(n, 1) = Now
                'Записываем адрес измененной ячейки
                .Cells(n, 2) = Target.Address
                'Записываем новое значение измененной ячейки
                .Cells(n, 3) = Target.Value
                'Скрываем лист со списком изменений
                .Visible = False
            End With
        Application.ScreenUpdating = True
    End If
End Sub

🛠 Как это работает:
🔹 Процедура Worksheet_Change отслеживает ручное изменение значений ячеек в любом месте листа, в модуле которого она размещена.
🔹 При обнаружении смены значения ячейки отображается скрытый лист "СписокИзменений", и в новой строке записываются: текущие дата и время, адрес измененной ячейки и ее новое значение.
🔹 После записи новой строки лист "СписокИзменений" скрывается.
🔹 Чтобы никто не заметил отображение скрытого листа "СписокИзменений", применено отключение обновлений экрана (Application.ScreenUpdating = False).

💡 Примечания:
🔸 При отслеживании изменения ячеек на всем листе, из процедуры Worksheet_Change можно убрать условие (If Not Intersect).
🔸 Если вам нужно отслеживать изменения ячеек в определенном диапазоне, а не на всем листе, замените в условии диапазон UsedRange на отслеживаемый диапазон.

#VBA #ExcelVBA #Список #Изменения #Отслеживание

🍰 Создание пользовательского меню

Создание пользовательских меню в Excel — это способ ускорить работу с большим количеством макросов. 🚀 Кнопки для часто используемых процедур будут всегда под рукой, без необходимости захода в редактор VBA.

В этом посте мы рассмотрим создание пользовательского меню для отдельной книги Excel с помощью объекта CommandBars. 🍧

Объект CommandBars позволяет добавлять меню и кнопки к интерфейсу Excel. Вот пример кода, который добавляет меню "Моё меню" с одним пунктом "Запуск макроса".

1️⃣ Процедуры, которые размещаются в стандартном модуле:

'Создание нового меню "Моё меню"
Sub AddCustomMenu()
    Dim cb As CommandBar
    Set cb = Application.CommandBars("Worksheet Menu Bar")
    
    Dim cbc As CommandBarControl
    ' Удаляем существующее меню, если оно есть
    On Error Resume Next
    cb.Controls("Моё меню").Delete
    On Error GoTo 0
    
    ' Добавляем новое меню
    Set cbc = cb.Controls.Add(Type:=msoControlPopup)
    cbc.Caption = "Моё меню"
    
    ' Добавляем пункт меню
    Dim cbb As CommandBarButton
    Set cbb = cbc.Controls.Add(Type:=msoControlButton)
    cbb.Caption = "Запуск макроса"
    cbb.FaceId = 263 'Иконка для пункта меню
    cbb.OnAction = "MyMacro"
End Sub

'Удаление существующего меню "Моё меню"
Sub DeleteCustomMenu()
    On Error Resume Next
    Application.CommandBars("Worksheet Menu Bar").Controls("Моё меню").Delete
    On Error GoTo 0
End Sub

'Макрос, привязанный к пункту меню "Запуск макроса"
Sub MyMacro()
    MsgBox "Кнопка работает, макрос запущен!"
End Sub

2️⃣ Процедуры, которые размещаются в модуле книги:

'Запускает создание меню "Моё меню" при открытии книги
Private Sub Workbook_Open()
    AddCustomMenu
End Sub

'Запускает удаление меню "Моё меню" при закрытии книги
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    DeleteCustomMenu
End Sub

💡 Особенности для разных версий Excel
🔸 В версиях до 2007 года пользовательское меню отображается в строке меню.
🔸 В Excel 2007 и новее пользовательское меню появляется на вкладке "Надстройки" (Add-Ins).

#VBA #ExcelVBA #Меню #Создание #CommandBars

Изображение к посту:
🔒 Защита кода VBA паролем

🔒 Защита кода VBA паролем

Стандартный способ защиты кода VBA включает использование встроенных средств Microsoft Office. Процесс прост и состоит из следующих шагов:

1️⃣ Откройте редактор VBA, нажав Alt+F11 или через вкладку "Разработчик" > "Visual Basic".
2️⃣ В меню выберите Tools > VBAProject Properties.
3️⃣ Перейдите на вкладку Protection, поставьте галочку "Lock project for viewing".
4️⃣ Введите пароль в поля "Password" и "Confirm password", нажмите 🆗.
5️⃣ Сохраните файл и перезапустите его. Теперь код будет выполняться, но для просмотра или редактирования потребуется пароль.

💡 Если забудете пароль — восстановить его невозможно! Запишите его и храните в безопасном месте.

⚠️ Ограничения стандартной защиты
🔹 Защита кода VBA встроенными средствами Microsoft Office не является полностью надежной и может быть взломана опытными пользователями. 🔑
🔹 Пароли VBA легко взламываются с помощью специализированных программ.
🔹 Стандартная защита не рекомендуется для критически важных или конфиденциальных данных, так как она не обеспечивает высокий уровень безопасности.

#VBA #ExcelVBA #Пароль #Защита #Проект #Установить

🔑 Снятие пароля с проекта VBA Excel

😕 Как было сказано в предыдущем посте, если забыть пароль, установленный для кода VBA Excel, восстановить его будет невозможно.

🙂 Но зато его можно будет снять с проекта VBA вручную, а потом, если необходимо, установить новый.

👌 Ознакомьтесь с пошаговой инструкцией, как можно снять пароль с проекта VBA Excel вручную, начиная с версии 2007 года.

⚔️ Пошаговая инструкция
1️⃣ Сделайте копию книги Excel, чтобы случайно не потерять ее.
2️⃣ Откройте файл .xlsm любым архиватором (7-Zip, WinRAR).
3️⃣ Откройте в архиве папку «xl», найдите файл «vbaProject.bin» и перетащите его с копированием в папку с книгой Excel (можно в любую папку).
4️⃣ Откройте файл «vbaProject.bin» программой «Notepad++», обычный блокнот не подойдет (об этом в первом примечании).
5️⃣ С помощью поиска (Ctrl+F) найдите фразу «DPB=», замените в ней букву «B» на любую другую, например на «z» и сохраните файл.
6️⃣ Перетащите файл «vbaProject.bin» обратно в архив, подтвердив копирование. Архив можно закрыть.
7️⃣ Откройте книгу Excel и на запрос о продолжении загрузки с невалидным ключом «DPz» ответьте «Да».
8️⃣ Откройте редактор VBA, трижды или четырежды нажав «OK» в сообщении о неизвестной ошибке.
9️⃣ Сохраните книгу Excel и закройте.
🔟 Откройте файл Excel, перейдите в редактор VBA, откройте окно «Tools» >> «VBAProject Properties», перейдите на вкладку «Protection» и убедитесь, что галочка у чек-бокса «Lock project for viewing» снята, поля «Password» и «Confirm password» — пустые.

💡 Примечания
🔹 По пункту 3️⃣: не помню, почему я писал, что обычный блокнот не подойдет, — блокнот Windows 11 подходит. Возможно, в предыдущих версиях блокнота были проблемы с кодировкой.
🔹 По пункту 8️⃣: раньше у меня сообщение о неизвестной ошибке появлялось три раза, но после обновления ОС до Windows 11 и переустановки офисных программ (Office LTSC, определяется, как версия 2016) сообщение о неизвестной ошибке стало появляться четыре раза.
🔹 После вышеуказанных обновлений проявился и другой странный эффект, который раньше не наблюдался: после открытия файла .xlsm архиватором, он и другие Excel-файлы перестают открываться программой Excel (правда, не всегда). Все восстанавливается после перезагрузки компьютера.

#VBA #ExcelVBA #Пароль #Защита #Проект #Снять