🚀 Ускоряем макросы с Application.ScreenUpdating
При запуске макросов Excel может "подвисать" из-за постоянного обновления экрана при изменении данных на рабочем листе. Чтобы ускорить выполнение кода, используйте Application.ScreenUpdating!

🛠 Как это работает?
🔹 Application.ScreenUpdating = False – отключает обновление экрана, ускоряя выполнение кода.
🔹 Application.ScreenUpdating = True – включает обновление после выполнения макроса.

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

Sub FastMacro()
    Application.ScreenUpdating = False ' Выключаем обновление экрана
    
    Dim i As Integer
    For i = 1 To 1000
        Cells(i, 1).Value = i
        Cells(i, 1).Copy Cells(i, 2)
        Cells(i, 2).Copy Cells(i, 3)
    Next i
    
    Application.ScreenUpdating = True ' Включаем обновление экрана
End Sub

📌 Почему это важно?
🔸 Без ScreenUpdating = False Excel перерисовывает экран после каждого изменения, замедляя макрос.
🔸 После выполнения кода обязательно включайте обновление обратно, чтобы не было проблем с интерфейсом.

💡 Используйте этот метод для ускорения макросов, особенно при работе с большими таблицами! ⚡️🚀

#VBA #ExcelVBA #Screen #Updating #Экран #Обновление

⚠️ Отключение предупреждений в VBA

При выполнении макросов Excel часто показывает всплывающие окна с вопросами:
🔸 "Файл уже существует. Заменить?"
🔸 "Удалить лист?"
🔸 "Преобразовать данные?"

Чтобы избежать лишних сообщений и автоматизировать выполнение макроса, используйте Application.DisplayAlerts! 🚀

🛠 Как это работает?
🔹 Application.DisplayAlerts = False – отключает предупреждения.
🔹 Application.DisplayAlerts = True – включает обратно.

📌 Пример удаления листа без подтверждения

Sub DeleteSheetWithoutAlert()
    Application.DisplayAlerts = False ' Отключаем предупреждения
        Sheets("Лист1").Delete ' Удаляем лист без всплывающего окна
    Application.DisplayAlerts = True ' Включаем обратно
End Sub

💡 Важно!
🔸 Не забудьте вернуть DisplayAlerts = True, чтобы Excel не оставался без уведомлений!
🔸 Используйте только когда уверены, что диалоговые окна не нужны.

⚡️ Этот способ полезен при автоматической обработке файлов, экспорте и удалении данных!

#VBA #ExcelVBA #Display #Alerts #Отключение #Предупреждения

🎯 Оператор Option Explicit – защита от ошибок

При написании кода VBA можно легко допустить опечатку в названии переменной. Например, если написать TotalSuum вместо TotalSum, Excel не выдаст ошибку, а просто создаст новую переменную с пустым значением. А если в коде присутствует много необъявленных переменных, то в них легко и запутаться.

Чтобы избежать таких ситуаций, используйте оператор Option Explicit! 🚀

🛠 Как это работает?
🔹 Оператор Option Explicit заставляет объявлять все переменные перед их использованием.
🔹 Если переменная не объявлена, код не запустится и выдаст ошибку "Variable not defined".

📎 Как применять?
🔹 Можно вручную добавить оператор Option Explicit в самом начале модуля.
🔹 Можно автоматически добавлять Option Explicit во всех новых модулях, если включить его в настройках редактора VBA: Tools → Options → Require Variable Declaration ✅.

Option Explicit ' Обязательное объявление переменных

Sub Example()
    Dim TotalSum As Double
        TotalSum = 100
    MsgBox TotalSum
End Sub

📌 Преимущества использования оператора Option Explicit:
🔸 Предотвращает опечатки в именах переменных.
🔸 Уменьшает количество скрытых ошибок.
🔸 Делает код понятнее и надежнее.

Используйте Option Explicit, чтобы ваш код был чистым и без неожиданных багов! 🔥

#VBA #ExcelVBA #OptionExplicit #Переменная #Защита #Ошибка

🔗 Удаление всех гиперссылок

Иногда возникает необходимость удалить все гиперссылки с рабочего листа Excel. Это легко сделать с помощью VBA. 🚀

1️⃣ Удаление с рабочего листа всех гиперссылок, вставленных в ячейки вручную, через панель инструментов «Вставка» или с помощью кода VBA:

Sub RemoveHyperlinksSheet()
    ActiveSheet.Hyperlinks.Delete
End Sub

Этот код удалит только ссылки, а тексты ссылок не затронет.

2️⃣ Удаление с рабочего листа всех гиперссылок, вставленных в виде формул:

Sub RemoveHyperlinkFormulas()
    Dim cell As Range
    For Each cell In ActiveSheet.UsedRange
        If cell.HasFormula And InStr(cell.Formula, "HYPERLINK(") > 0 Then
            cell.ClearContents
        End If
    Next cell
End Sub

Этот код удалит и ссылки, и тексты ссылок, так как они были аргументами формул.

#VBA #ExcelVBA #Hyperlink #Гиперссылка

↪️ On Error Resume Next

При выполнении макросов могут возникать ошибки: деление на ноль, отсутствие файла, неверные данные и т. д. Чтобы программа не прерывалась, можно использовать оператор On Error Resume Next – игнорирование ошибок в VBA.

📌 Пример

' Включаем игнорирование ошибок
On Error Resume Next
     ' Отключаем оповещения
     Application.DisplayAlerts = False
          Sheets("Оглавление").Delete
     ' Включаем оповещения
     Application.DisplayAlerts = True
' Отключаем игнорирование ошибок
On Error GoTo 0

🛠 Как это работает?
🔹 Оператор On Error Resume Next включает обработчик ошибок, который игнорирует ошибки после него и позволяет коду продолжать выполнение.
🔹 После прохождения участка кода, где предполагалось игнорировать ошибки, желательно отключить обработку ошибок.
🔹 Оператор On Error GoTo 0 отключает обработчик ошибок и возвращает стандартное поведение VBA при обнаружении ошибок.

👍 Когда использовать?
🔹 Когда ошибка не критична и не должна прерывать выполнение кода.
🔹 При проверке существования файлов, листов, диапазонов.
🔹 В блоках кода, где ошибка не влияет на общий результат.

🚫 Не стоит использовать повсеместно! Это может скрывать важные ошибки, делая код сложным для отладки.

#VBA #ExcelVBA #OnError #ResumeNext #GoTo0 #ОбработкаОшибок

↩️ On Error GoTo Label

В отличие от On Error Resume Next, который игнорирует ошибки, оператор On Error GoTo Label позволяет перенаправить выполнение кода в специальный блок для обработки ошибок.

🛠 Как это работает?
При возникновении ошибки после оператора On Error GoTo Label выполнение кода переключается на указанный Label (метку), где происходит обработка ошибки.

📌 Пример

Sub Primer()
    On Error GoTo ErrorHandler ' Переключаем обработку ошибок на метку ErrorHandler
    
    Dim x As Double
        x = 10 / 0 ' Ошибка: деление на ноль (division by zero)
    MsgBox "Результат: " & x
    
    Exit Sub ' Выход из процедуры, чтобы не выполнить код обработки ошибки
    
ErrorHandler: ' Метка для обработки ошибок
    MsgBox "Ошибка №" & Err.Number & ": " & Err.Description, vbCritical, "Ошибка"
End Sub

❓ Зачем нужен On Error GoTo Label?
🔸 Позволяет перехватывать ошибки и выполнять альтернативные действия.
🔸 Позволяет идентифицировать ошибки для дальнейшего анализа.
🔸 Позволяет безопасно завершить макрос без внезапных остановок.

💡 Важно!
🔹 Если необходимо отключить обработку ошибок On Error GoTo Label внутри кода, используйте оператор On Error GoTo 0.
🔹 Не забывайте ставить Exit Sub перед меткой, чтобы код обработки ошибок не выполнялся в обычном режиме.
🔹 При отладке процедуры оператор On Error GoTo Label лучше закомментировать, чтобы VBA подсвечивал строку кода с ошибкой. 🔦

#VBA #ExcelVBA #OnError #GoTo #Label #ОбработкаОшибок

📂 Чтение текста из файла с помощью FileSystemObject

В VBA Excel для работы с файлами удобно использовать объект FileSystemObject (FSO). Он позволяет читать, записывать и управлять файлами.

🎤 Объявление FileSystemObject
🔹 Объявить переменную как FileSystemObject можно с ранней или поздней привязкой.
🔹 Чтобы использовать раннюю привязку, необходимо подключить библиотеку Microsoft Scripting Runtime (Tools - References - установите галочку перед Microsoft Scripting Runtime - нажмите 🆗).
🔹 Поздняя привязка не требует подключения библиотеки Microsoft Scripting Runtime к проекту VBA.

' Ранняя привязка
Dim fso As New FileSystemObject
' Поздняя привязка
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")

📌 Примеры

1️⃣ Чтение всего текста из файла сразу:

Sub Primer1()
    Dim fso, fl, st As String
        ' Создаем новый экземпляр объекта FileSystemObject
        Set fso = CreateObject("Scripting.FileSystemObject")
        ' Открываем файл для чтения
        Set fl = fso.OpenTextFile("C:\Test\Текстовый документ.txt")
        ' Считываем весь текст из файла в переменную st
        st = fl.ReadAll
        ' Закрываем файл
        fl.Close
    'Отображаем содержимое переменной в окне Immediate
    Debug.Print st
End Sub

2️⃣ Чтение текста из файла построчно:

Sub Primer2()
    Dim fso, fl, st As String
        ' Создаем новый экземпляр объекта FileSystemObject
        Set fso = CreateObject("Scripting.FileSystemObject")
        ' Открываем файл для чтения
        Set fl = fso.OpenTextFile("C:\Test\Текстовый документ.txt")
        ' Читаем построчно текст из файла и выводим в окно Immediate
            Do Until fl.AtEndOfStream
                st = fl.ReadLine
                Debug.Print st
            Loop
        ' Закрываем файл
        fl.Close
End Sub

В этом примере также читается весь файл, только построчно, и, соответственно, результат построчной записи в окно Immediate будет таким же, как и в первом примере.

#VBA #ExcelVBA #FileSystemObject #ReadAll #ReadLine

🔲 Максимизация окна Excel при открытии

Если у вас файлы Excel открываются узкой полоской вверху экрана или мелким квадратиком в правом углу, не зависимо от того, в каком состоянии они были закрыты, можно воспользоваться принудительной максимизацией окна Excel при открытии.

🔥 Ниже приведены примеры кода, которые работали у меня. Размещаются процедуры в модуле ЭтаКнига личной книги макросов.

1️⃣ Для Excel 2010

Private Sub Workbook_Open()
    Application.WindowState = xlMaximized
End Sub

2️⃣ Для Excel 2016

Private Sub Workbook_Open()
    Application.DisplayFullScreen = True
End Sub

💡 Возможно, второй код подойдет и для Excel 2010 - проверить не было возможности.

#VBA #Excel #Максимизация #Window #Maximized

🛠 Исправление ошибок в Personal.xlsb

Если в коде процедур, размещенных в личной книге макросов (Personal.xlsb) и запускаемых при загрузке Excel, будут допущены ошибки, Excel может перестать открываться.

🚀 Решается проблема следующим образом:

1️⃣ Перейдите в папку XLSTART:
🔹 Путь к папке XLSTART:
C:\Users\user\AppData\Roaming\Microsoft\Excel\XLSTART
🔹 Так как папка AppData - скрытая, у вас должно быть включено отображение скрытых папок
2️⃣ Переместите файл Personal.xlsb в другое место, например, в папку Excel.
3️⃣ Перезагрузите компьютер и откройте любой файл Excel с поддержкой макросов.
4️⃣ Откройте перемещенный файл Personal.xlsb (он появится в проводнике редактора VBA).
5️⃣ Исправьте ошибки в проблемной процедуре.
6️⃣ Сохраните и закройте Excel.
7️⃣ Переместите файл Personal.xlsb обратно в папку XLSTART.

💡 Если файл Personal.xlsb окажется поврежденным, его на 2 шаге можно просто удалить и, после перезагрузки, создать новый.

#VBA #Excel #XLSTART #Personalxlsb #ЛичнаяКнигаМакросов

📖 Открыть сайт или файл для просмотра

Самый простой способ открыть сайт или файл для просмотра из кода VBA Excel - использовать метод Workbook.FollowHyperlink. 🚀

🖊 Запись метода можно сделать в двух вариантах:
🔹 ThisWorkbook.FollowHyperlink Address:="https://www.travelpayouts.com/ru/?marker=95707.tg"
🔹 ThisWorkbook.FollowHyperlink ("https://www.travelpayouts.com/ru/?marker=95707.tg")

Я предпочитаю скобки. Хоть немного, но покороче 🙂.

📌 Примеры

1️⃣ Открываем сайт:

Sub OpenSite()
    On Error Resume Next
    ThisWorkbook.FollowHyperlink _
    ("https://vremya-ne-zhdet.ru/rabota-v-internete/travelpayouts-partnerskaya-programma/")
End Sub

2️⃣ Открываем файл:

Sub OpenFile()
    On Error Resume Next
    ThisWorkbook.FollowHyperlink _
    ("C:\Test\Текстовый документ.txt")
End Sub

💡 Примечания
🔹 Оператор On Error Resume Next необходим, чтобы завершить процедуру без ошибки, если указанный сайт или файл не существует.
🔹 В комментариях на сайте писали, что метод Workbook.FollowHyperlink не работает в VBA Excel 2007. Возможно, это частный случай.

#VBA #ExcelVBA #Workbook #FollowHyperlink #ОткрытьСайт #ОткрытьФайл

🏁 Добавление узора в ячейку

Добавление узора (штрихового рисунка) в ячейку осуществляется с помощью свойства Range.Interior.Pattern.

💡 Свойство Interior объекта Range возвращает объект Interior (внутренняя область диапазона), а свойство Pattern объекта Interior задает шаблон узора ячейки (диапазона) или возвращает его числовое значение.

Range.Interior.Pattern = ConstantXlPattern

где ConstantXlPattern – константа из коллекции XlPattern, задающая шаблон узора (штрихового рисунка).

🛠 Константы XlPattern с шаблонами узоров (штриховых рисунков) на изображении ниже.

#VBA #ExcelVBA #Range #Pattern #Ячейка #Узор

📌 Пример
Вставка узора «Шахматная доска» в диапазон A1:C3:

Sub Primer1()
    Range("A1:C3").Interior.Pattern = xlPatternChecker
End Sub

🏁 Украшение узора в ячейке

Штриховой рисунок можно украсить цветом (оттенком), за который отвечает свойство PatternThemeColor объекта Interior.

Range.Interior.PatternThemeColor = ConstantXlThemeColor

где ConstantXlThemeColor – константа из коллекции XlThemeColor, задающая цвет узора (штрихового рисунка).

🛠 Константы XlThemeColor с оттенками для узоров (штриховых рисунков) на изображении ниже.

#VBA #ExcelVBA #Range #PatternThemeColor #Ячейка #УзорЯчейки

В начале таблицы нет ошибок. Это разработчики пошутили или начудили 🤣: xlThemeColorDark соответствует оттенку Светлый, а xlThemeColorLight соответствует оттенку Темный.👏

📌 Примеры
Присвоение узору «Шахматная доска» в диапазоне A1:C3 из примера выше оттенков Темный2 и Светлый2:

Sub Primer2()
    Range("A1:C3").Interior.PatternThemeColor = xlThemeColorLight2 'Темный2
End Sub

Sub Primer3()
    Range("A1:C3").Interior.PatternThemeColor = xlThemeColorDark2 'Светлый2
End Sub

Использование галочки в ячейке 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 #Архив #Распаковка