🔍 Метод FindNext объекта Range
Метод FindNext используется вместе с Find, чтобы найти все вхождения искомого значения в диапазоне.

📌 Как работает FindNext?
🔹 Find ищет первое совпадение.
🔹 FindNext ищет следующее совпадение и т.д.
🔹 Если FindNext снова находит первую ячейку, поиск необходимо завершить.

📌 Примеры

1️⃣ Поиск всех совпадений в заданном диапазоне

Sub FindAllOccurrences()  
    Dim firstCell As String, cell As Range  
    Set cell = Range("A1:A100").Find(What:="Иван", LookIn:=xlValues)  

    If Not cell Is Nothing Then  
        firstCell = cell.Address ' Запоминаем первую найденную ячейку  
        Do  
            MsgBox "Найдено в: " & cell.Address  
            Set cell = Range("A1:A100").FindNext(cell) ' Ищем следующее  
        Loop While cell.Address <> firstCell  
    Else  
        MsgBox "Значение не найдено!"  
    End If  
End Sub  

2️⃣ Поиск всех совпадений и их выделение цветом

Sub HighlightAllMatches()  
    Dim firstCell As String, cell As Range  
    Set cell = Range("A1:A100").Find(What:="Иван", LookIn:=xlValues)  

    If Not cell Is Nothing Then  
        firstCell = cell.Address  
        Do  
            cell.Interior.Color = RGB(255, 255, 0) ' Закрашиваем найденную ячейку  
            Set cell = Range("A1:A100").FindNext(cell)  
        Loop While cell.Address <> firstCell  
    End If  
End Sub  

3️⃣ Поиск с учётом регистра и точного совпадения

Sub FindExactMatch()  
    Dim firstCell As String, cell As Range  
    Set cell = Range("A1:A100").Find(What:="ABC", LookAt:=xlWhole, MatchCase:=True)  

    If Not cell Is Nothing Then  
        firstCell = cell.Address  
        Do  
            MsgBox "Точное совпадение в " & cell.Address  
            Set cell = Range("A1:A100").FindNext(cell)  
        Loop While cell.Address <> firstCell  
    End If  
End Sub  

⚠️ Важно
🔹 FindNext продолжает поиск с последней найденной ячейки.
🔹 Если FindNext снова нашёл первую найденную ячейку, поиск необходимо завершить, чтобы не уйти в бесконечный цикл.

💡 Когда использовать?
✅ Если нужно найти все совпадения, а не только первое.
✅ В макросах, где данные обновляются, заменяются или выделяются.
✅ При анализе данных с повторяющимися значениями.

#VBA #ExcelVBA #FindNext #Поиск #Range

🔥 Метод Insert объекта Range
Метод Insert позволяет вставлять новые ячейки, строки или столбцы в диапазон, сдвигая существующие данные. Это аналог кнопки "Вставить" в Excel.

📌 Синтаксис

Range.Insert(Shift, CopyOrigin)  

🔹 Shift (необязательно) – определяет направление сдвига:
✅xlShiftDown – сдвиг вниз (для вставки строк);
✅xlShiftToRight – сдвиг вправо (для вставки ячеек).

🔹 CopyOrigin (необязательно) – копирует форматирование соседних ячеек:
✅xlFormatFromLeftOrAbove – копирует сверху или слева (по умолчанию);
✅xlFormatFromRightOrBelow – копирует снизу или справа.

📌 Примеры

1️⃣ Вставить пустую строку перед A1

Sub InsertRow()  
    Range("A1").EntireRow.Insert  
End Sub  

2️⃣ Вставить новый столбец перед A

Sub InsertColumn()  
    Range("A1").EntireColumn.Insert  
End Sub  

3️⃣ Вставить ячейки со сдвигом вниз

Sub InsertCellsDown()  
    Range("B2:C3").Insert Shift:=xlShiftDown  
End Sub  

4️⃣ Вставить ячейки со сдвигом вправо

Sub InsertCellsRight()  
    Range("B2:B5").Insert Shift:=xlShiftToRight  
End Sub  

5️⃣ Вставить строку и скопировать формат сверху

Sub InsertRowWithFormat()  
    Range("A5").EntireRow.Insert CopyOrigin:=xlFormatFromLeftOrAbove  
End Sub  

⚠️ Важно:
🔹 Если в Insert не указать Shift, Excel сам выберет направление сдвига.
🔹 Если диапазон — целая строка (EntireRow) или столбец (EntireColumn), то вставка сдвигает весь лист.
🔹 При вставке столбца или строки копирование форматов (CopyOrigin) помогает сохранить стиль таблицы.

💡 Когда использовать?
✅ Автоматическое добавление строк/столбцов в таблицы.
✅ Вставка новых данных без потери существующих.

#VBA #ExcelVBA #Insert #Range #Вставка

🔗 Метод Merge объекта Range
Метод Merge позволяет объединять несколько ячеек в одну, сохраняя только верхнее левое значение. Это эквивалент кнопки "Объединить и поместить в центр" в Excel.

📌 Синтаксис

Range.Merge (Across)  

🔹 Across (необязательный) – объединение по строкам:
✅ True – объединяет только по горизонтали (в каждой строке отдельно).
✅ False (по умолчанию) – объединяет весь диапазон в одну ячейку.

📌 Примеры

1️⃣ Объединить диапазон в одну ячейку

Sub MergeCells()  
    Range("A1:C3").Merge  
End Sub  

2️⃣ Объединить ячейки в каждой строке отдельно

Sub MergeAcrossRows()  
    Range("A1:C3").Merge Across:=True  
End Sub  

3️⃣ Объединить и установить текст в центр

Sub MergeAndCenter()  
    With Range("B2:D2")  
        .Merge  
        .HorizontalAlignment = xlCenter  
    End With  
End Sub  

4️⃣ Проверить, объединены ли ячейки

Sub CheckMergedCells()  
    If Range("A1").MergeCells Then  
        MsgBox "Ячейка A1 объединена!"  
    Else  
        MsgBox "Ячейка A1 не объединена."  
    End If  
End Sub  

5️⃣ Разъединить объединённые ячейки

Sub UnmergeCells()  
    Range("A1:C3").UnMerge  
End Sub  

⚠️ Важно:
🔹 После Merge остаётся только верхнее левое значение, остальные данные теряются!
🔹 Если не задать Across:=True, Excel объединит всю область в одну ячейку.
🔹 Использование Merge может мешать сортировке и обработке данных, поэтому иногда лучше применять CenterAcrossSelection для выравнивания текста.

Sub CenterAcrossSelectionExample()
    Range("B1:F1").HorizontalAlignment = xlCenterAcrossSelection
End Sub

💡 Когда использовать?
✅ Форматирование заголовков и шапок таблиц.
✅ Создание отчётов с объединёнными ячейками.
✅ Визуальное оформление данных.

#VBA #ExcelVBA #Merge #Range #Объединение

📋 Метод PasteSpecial объекта Range
Метод PasteSpecial позволяет вставлять не просто данные, а формулы, форматы, значения, ширину столбцов и другие элементы. Это аналог кнопки "Специальная вставка" в Excel.

📌 Синтаксис

Range.PasteSpecial (Paste, Operation, SkipBlanks, Transpose)  

🛠 Параметры
🔹 Paste – что вставлять (значения, формулы, форматы и т. д.).
🔹 Operation – математическая операция (xlAdd, xlSubtract и др.).
🔹 SkipBlanks – игнорировать пустые ячейки (True / False).
🔹 Transpose – поменять местами строки и столбцы (True / False).

📌 Примеры

1️⃣ Вставить только значения (без формул)

Sub PasteValues()  
    Range("A1:A10").Copy  
    Range("C1").PasteSpecial Paste:=xlPasteValues  
    Application.CutCopyMode = False ' Убираем режим копирования  
End Sub  

2️⃣ Вставить только форматы ячеек

Sub PasteFormats()  
    Range("A1:A10").Copy  
    Range("C1").PasteSpecial Paste:=xlPasteFormats  
End Sub  

3️⃣ Вставить ширину столбцов

Sub PasteColumnWidths()  
    Range("A:A").Copy  
    Range("C:C").PasteSpecial Paste:=xlPasteColumnWidths  
End Sub  

4️⃣ Вставить формулы без форматирования

Sub PasteFormulas()  
    Range("A1:A10").Copy  
    Range("C1").PasteSpecial Paste:=xlPasteFormulas  
End Sub  

5️⃣ Вставить транспонированные данные (строки → столбцы)

Sub PasteTransposed()  
    Range("A1:D1").Copy  
    Range("A3").PasteSpecial Paste:=xlPasteValues, Transpose:=True  
End Sub  

⚠️ Важно:
🔹 Перед PasteSpecial всегда нужно вызывать Copy, чтобы вставка сработала (из буфера обмена).
🔹 Application.CutCopyMode = False убирает мигающую рамку (марш муравьев) вокруг скопированных данных.
🔹 Если SkipBlanks:=True, пустые ячейки не будут заменять данные в целевом диапазоне.

💡 Когда использовать?
✅ Удаление формул, оставляя только значения.
✅ Копирование только форматов или ширины столбцов.
✅ Изменение структуры данных (транспонирование).

#VBA #ExcelVBA #PasteSpecial #Range #СпециальнаяВставка #Копирование

🔄 Метод RemoveDuplicates объекта Range
Метод RemoveDuplicates позволяет удалить повторяющиеся строки в указанном диапазоне, оставляя только первое уникальное вхождение. Это аналог кнопки "Удалить дубликаты" в Excel.

📌 Синтаксис

Range.RemoveDuplicates Columns, Header  

🔹 Columns – массив номеров столбцов, по которым удаляются дубликаты (например, Array(1, 3)).
🔹 Header – указание наличия заголовка:
✅ xlYes – первая строка считается заголовком.
✅ xlNo – все строки участвуют в удалении дубликатов.
✅ xlGuess (по умолчанию) – Excel сам определяет наличие заголовков.

📌 Примеры

1️⃣ Удалить дубликаты по первому столбцу

Sub RemoveDuplicatesOneColumn()  
    Range("A1:A10").RemoveDuplicates Columns:=1, Header:=xlNo  
End Sub  

2️⃣ Удалить дубликаты по нескольким столбцам (A и C)

Sub RemoveDuplicatesMultipleColumns()  
    Range("A1:C10").RemoveDuplicates Columns:=Array(1, 3), Header:=xlYes  
End Sub  

3️⃣ Удалить дубликаты с автоматическим определением заголовка

Sub RemoveDuplicatesAutoHeader()  
    Range("A1:D20").RemoveDuplicates Columns:=2, Header:=xlGuess  
End Sub  

4️⃣ Удалить дубликаты во всём диапазоне данных

Sub RemoveAllDuplicates()  
    Dim ws As Worksheet  
    Set ws = ActiveSheet  
    ws.UsedRange.RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes  
End Sub  

⚠️ Важно
🔹 Метод сохраняет первое вхождение, удаляя все последующие дубликаты.
🔹 Если Header:=xlYes, Excel не считает заголовок первым вхождением.
🔹 Работает только для строк с точным повторением значений в указанных столбцах — если данные в строке повторяются по указанным столбцам в другом порядке, метод их не удалит.

💡 Когда использовать?
✅ Очистка больших таблиц от повторяющихся данных.
✅ Фильтрация уникальных значений для последующего анализа.

#VBA #ExcelVBA #RemoveDuplicates #Range #УдалениеДубликатов

🔳 Метод Select объекта Range
Метод Select используется для выбора (выделения) диапазона на листе. Это аналог ручного выделения ячеек в Excel с помощью мыши или клавиатуры.

📌 Примеры

1️⃣ Выделить одну ячейку

Sub SelectSingleCell()  
    Range("B2").Select  
End Sub  

2️⃣ Выделить диапазон ячеек

Sub SelectRange()  
    Range("A1:D5").Select  
End Sub  

3️⃣ Выделить весь столбец

Sub SelectColumn()  
    Columns("B").Select  
End Sub  

4️⃣ Выделить всю строку

Sub SelectRow()  
    Rows("3").Select  
End Sub  

5️⃣ Выделить ячейки с данными (используем CurrentRegion)

Sub SelectDataRegion()  
    Range("A1").CurrentRegion.Select  
End Sub  

6️⃣ Выделить последнюю заполненную строку в столбце A

Sub SelectLastRow()  
    Dim LastRow As Long  
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row  
    Range("A" & LastRow).Select  
End Sub  

7️⃣ Выделить последнюю заполненную колонку в строке 1

Sub SelectLastColumn()  
    Dim LastCol As Long  
    LastCol = Cells(1, Columns.Count).End(xlToLeft).Column  
    Cells(1, LastCol).Select  
End Sub  

⚠️ Важно
🔹 Метод Select не всегда нужен в VBA, так как большинство операций можно выполнить без выделения ячеек.
🔹 Метод Select работает на активном листе. Если необходимый лист неактивен, его необходимо активировать:

Sheets("Лист1").Activate  
Range("A1").Select  

💡 Когда использовать?
✅ При создании макросов, которые имитируют пользовательские действия.
✅ В кодах для навигации по ячейкам.

#VBA #ExcelVBA #Select #Range #Выделение #ВыделениеЯчеек

🔄 Переопределение размерности массивов
Переопределять размерность динамических массивов в одной процедуре можно неоднократно, как по количеству измерений, так и по количеству элементов в измерении. Для переопределения размерности используется оператор ReDim.

📌 Примеры

1️⃣ Переопределение массивов с указанием размеров числами

Dim Massiv1() As Integer, Massiv2() As String
ReDim Massiv1(1 To 20)
ReDim Massiv2(3, 5, 4)

2️⃣ Переопределение массива с помощью переменной

Dim Massiv1() as Variant, x As Integer
x = 20
ReDim Massiv1(1 To x)

При переопределении размерности динамических массивов в VBA Excel теряются значения их элементов. Чтобы сохранить значения используется оператор Preserve.

3️⃣ Переопределение массива с сохранением значений

Dim Massiv1() As String
----- операторы -----
ReDim Massiv1(5, 2, 3)
----- операторы -----
ReDim Preserve Massiv1(5, 2, 7)

⚠️ Важно
🔹 Переопределяемый массив должен быть динамическим. При попытке переопределить массив, объявленный с указанием размерности (Dim Massiv(1 To 9) As String), произойдет ошибка компиляции с сообщением: Array already dimensioned (Массив уже имеет размерность).
🔹 Переопределить с оператором Preserve можно только последнюю размерность динамического массива. Это недоработка разработчиков, которая сохранилась и в VBA Excel 2016. Без оператора Preserve можно переопределить все размерности.

4️⃣ Еще один пример с ReDim Preserve

Sub Primer()
Dim x() As Byte, i1 As Byte, i2 As Byte, i3 As Byte
    ReDim x(2, 2, 2)
        For i1 = 0 To 2
            For i2 = 0 To 2
                For i3 = 0 To 2
                    x(i1, i2, i3) = i1 + i2 + i3
                Next
            Next
        Next
    ReDim Preserve x(2, 2, 3)
End Sub

Так все работает, но при попытке переопределения размерности: ReDim Preserve x(3, 2, 3) или даже ReDim Preserve x(2, 3, 2), происходит ошибка "Run-time error '9': Subscript out of range" (Ошибка времени выполнения '9': Индекс вне диапазона).

#VBA #ReDim #Preserve #Array #Массив #Размерность

🔢 Метод Sort объекта Range
Метод Sort позволяет отсортировать данные в указанном диапазоне по одному или нескольким столбцам. Это аналог кнопки "Сортировка" в Excel.

📌 Синтаксис

Range.Sort Key1, Order1, Key2, Order2, Key3, Order3, Header, OrderCustom, MatchCase, Orientation, DataOption1, DataOption2, DataOption3  

🔹 Key1 – первый столбец для сортировки (Range("A1")).
🔹 Order1 – порядок (xlAscending – по возрастанию, xlDescending – по убыванию).
🔹 Header – есть ли заголовки (xlYes / xlNo / xlGuess).
🔹 Orientation – направление (xlSortRows – по строкам, xlSortColumns – по столбцам).
🔹 Остальные параметры – дополнительные уровни сортировки.

📌 Примеры

1️⃣ Простая сортировка по возрастанию (столбец A)

Sub SortAscending()  
    Range("A1:A10").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo  
End Sub  

2️⃣ Сортировка по убыванию (столбец B)

Sub SortDescending()  
    Range("B1:B10").Sort Key1:=Range("B1"), Order1:=xlDescending, Header:=xlYes  
End Sub  

3️⃣ Сортировка по двум столбцам (сначала по A, потом по B)

Sub SortTwoColumns()  
    Range("A1:C10").Sort _  
        Key1:=Range("A1"), Order1:=xlAscending, _  
        Key2:=Range("B1"), Order2:=xlDescending, _  
        Header:=xlYes  
End Sub  

✅ 4. Сортировка без учета регистра

Sub SortCaseInsensitive()  
    Range("A1:A10").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, MatchCase:=False  
End Sub  

5️⃣ Сортировка по строкам (не по столбцам!)

Sub SortByRows()  
    Range("A1:D5").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, Orientation:=xlSortRows  
End Sub  

⚠️ Важно
🔹 Если в диапазоне есть заголовки, указывайте Header:=xlYes, иначе заголовок будет отсортирован вместе с данными.
🔹 MatchCase:=True учитывает регистр, а False — игнорирует.
🔹 Orientation:=xlSortRows используется для сортировки по строкам, а xlSortColumns (по умолчанию) — для сортировки по столбцам.

#VBA #ExcelVBA #Sort #Range #Сортировка

🔄 Метод UnMerge объекта Range
Метод UnMerge используется для разъединения ранее объединенных ячеек в указанном диапазоне. Он выполняет обратное действие методу Merge.

📌 Примеры

1️⃣ Разъединить объединенные ячейки:

Sub UnMergeRange()
'    Range("A1:D5").Merge
    Range("A1:D5").UnMerge
End Sub

2️⃣ Отмена объединения по одной ячейке:

Sub UnMergeSingleCell()
'    Range("A1:D5").Merge
    Range("A1").UnMerge
End Sub

Разъединены будут все ячейки, составляющие объединенную ячейку.

3️⃣ Разъединить все объединенные ячейки на активном листе:

Sub UnMergeAll()  
    ActiveSheet.Cells.UnMerge  
End Sub  

4️⃣ Разъединить объединенные ячейки и заполнить их значением верхней левой ячейки:

Sub UnMergeAndFill()
    Dim rng As Range, addr As String, val As Variant
    For Each rng In ActiveSheet.UsedRange
        If rng.MergeCells Then
            addr = rng.MergeArea.Address  ' Сохраняем адрес объединенной области
            val = rng.Cells(1, 1).Value  ' Сохраняем значение из первой ячейки
            rng.UnMerge  ' Разъединяем ячейки
            Range(addr).Value = val  ' Вставляем сохраненное значение во все ячейки
        End If
    Next rng
End Sub

⚠️ Важно
🔹 Если объединенная ячейка содержала данные, после UnMerge значение останется только в верхней левой ячейке, а остальные станут пустыми. Если хотите сохранить данные во всех разъединенных ячейках, используйте пример 4.

💡 Когда использовать?
✅ При подготовке данных для работы (объединенные ячейки могут мешать обработке).
✅ Перед выполнением операций копирования, вставки или сортировки.
✅ Для автоматической очистки листов от объединений.

#VBA #ExcelVBA #UnMerge #Range #ОбъединенныеЯчейки

🔍 Метод Replace объекта Range
Метод Replace позволяет искать и заменять значения в указанном диапазоне. Это аналог функции "Найти и заменить" (Ctrl + H) в Excel, но с возможностью автоматизации через VBA.

📌 Синтаксис

Range.Replace What, Replacement, [LookAt], [SearchOrder], [MatchCase], [MatchByte], [SearchFormat], [ReplaceFormat]  

🔹 What – что ищем.
🔹 Replacement – на что заменяем.
🔹 LookAt – искать целую ячейку (xlWhole) или часть (xlPart).
🔹 SearchOrder – искать по строкам (xlByRows) или по столбцам (xlByColumns).
🔹 MatchCase – учитывать ли регистр (по умолчанию False).
🔹 SearchFormat, ReplaceFormat – искать/заменять с учетом форматов.

📌 Примеры

1️⃣ Простая замена текста в диапазоне

Sub ReplaceText()  
    Range("A1:A10").Replace What:="Ошибка", Replacement:="Исправлено"  
End Sub  

Заменит "Ошибка" на "Исправлено" в диапазоне A1:A10.

2️⃣ Замена с учетом регистра

Sub ReplaceCaseSensitive()  
    Range("B1:B10").Replace What:="День", Replacement:="Ночь", MatchCase:=True  
End Sub  

Заменит "День" на "Ночь", но "день" или "ДЕНЬ" не изменит.

3️⃣ Замена в ячейках, которые содержат только искомый текст

Sub ReplaceWholeCell()  
    Range("C1:C10").Replace What:="100", Replacement:="200", LookAt:=xlWhole  
End Sub  

Заменит только в ячейках, содержащих ровно "100". Если в ячейке "1000" — не изменит.

4️⃣ Замена по всему листу с поиском по столбцам

Sub ReplaceOnSheet()  
    Cells.Replace What:="USD", Replacement:="EUR", SearchOrder:=xlByColumns  
End Sub  

Заменит "USD" на "EUR" во всех ячейках листа, поиск будет идти по столбцам.

5️⃣ Замена с учетом формата ячейки

Sub ReplaceBoldText()
    Application.FindFormat.Font.Bold = True ' Настроить поиск жирного текста
    Cells.Replace What:="Ошибка", Replacement:="Исправлено", SearchFormat:=True
    Application.FindFormat.Clear ' Очищаем формат поиска
End Sub

Заменит текст только в тех ячейках, где "Ошибка" была написана жирным шрифтом.

#VBA #ExcelVBA #Replace #Range #Автоматизация #Замена

👌 Список подключенных библиотек
В окне «References - VBAProject» (Tools —> References...) отмечены галочкой все библиотеки, подключенные к вашим проектам VBA. Следующий код выводит список всех подключенных библиотек на рабочий лист:

Sub ListGUID()
    Dim Ref As Object
        Sheets.Add ' создаем новый лист или
        ' [A1:D100].Clear ' очищаем диапазон на активном листе
        [A1:D1] = Array("Description", "Name", "GUID", "FullPath")
        [A1:D1].Font.Bold = True
            For Each Ref In ActiveWorkbook.VBProject.References
                  [A100].End(xlUp).Offset(1, 0) = Ref.Description
                  [B100].End(xlUp).Offset(1, 0) = Ref.Name
                  [C100].End(xlUp).Offset(1, 0) = """" & Ref.GUID & """"
                  [D100].End(xlUp).Offset(1, 0) = Ref.FullPath
            Next
        Columns("A:D").EntireColumn.AutoFit
    Set Ref = Nothing
End Sub

#VBA #ExcelVBA #References #GUID

📝 Текст в строке состояния
С помощью кода VBA можно записать свой текст в строку состояния программы Excel:

Sub StatusBarNewText()
    Application.StatusBar = "Не пора ли приготовить кофе?"
End Sub

#VBA #ExcelVBA #StatusBar #Текст

Чтобы вернуть StatusBar в исходное состояние, используйте следующий код:

Sub StatusBarReturn()
    Application.StatusBar = False
End Sub

🧾 Смена заголовка окна Excel
Заголовок окна открытой книги Excel 2016 состоит из двух частей: Имя книги (Книга1.xlsm) - Имя программы (Excel). Можно изменить и имя книги, и имя программы.

📌 Примеры

1️⃣ Удаляем имя книги и заменяем имя программы:

Sub CaptionNew1()
    ActiveWindow.Caption = ""
    Application.Caption = "Пора готовить кофе!"
End Sub

2️⃣ Заменяем имя книги и имя программы:

Sub CaptionNew2()
    ActiveWindow.Caption = "Перерыв"
    Application.Caption = "пора готовить кофе!"
End Sub

#VBA #ExcelVBA #ActiveWindow #Caption #Заголовок

3️⃣ Возвращаем заголовок в исходное состояние:

Sub CaptionReturn()
    ActiveWindow.Caption = ThisWorkbook.Name
    Application.Caption = Empty
End Sub

🔄 Создание резервной копии файла
Создание резервной копии файла в VBA Excel перед внесением очередных изменений и при закрытии файла.

1️⃣ Создание резервной копии файла Excel в процессе редактирования:

Sub BackupToFolder()
    Dim BackupFolder As String
    
    ' Папка для копий
    BackupFolder = ThisWorkbook.Path & "\Backup"
    
    ' Проверяем, существует ли папка, если нет, то создаем ее
    If Dir(BackupFolder, vbDirectory) = "" Then MkDir BackupFolder
    
    ' Сохраняем книгу
    ThisWorkbook.Save
    
    ' Сохраняем резервную копию
    ThisWorkbook.SaveCopyAs BackupFolder & "\Копия_от_" & Format(Now, "yyyy-mm-dd_hh-mm-ss") & ".xlsm"
      
    MsgBox "Копия сохранена в папку: " & BackupFolder, vbInformation
End Sub

🔹 Если вы сохраняете в одну папку «Backup» несколько файлов, имена копий можно разделить, добавив имя сохраняемого файла между словами «Копия» и «от»:

' Сохраняем резервную копию
    ThisWorkbook.SaveCopyAs BackupFolder & "\Копия_" & ThisWorkbook.Name & "_от_" & Format(Now, "yyyy-mm-dd_hh-mm-ss") & ".xlsm"

2️⃣ Автоматическое создание резервной копии при закрытии файла. Код размещаем в модуле книги.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim BackupFolder As String
    
    ' Папка для копий
    BackupFolder = ThisWorkbook.Path & "\Backup"
    
    ' Проверяем, существует ли папка, если нет, то создаем ее
    If Dir(BackupFolder, vbDirectory) = "" Then MkDir BackupFolder
    
    ' Сохраняем книгу
    ThisWorkbook.Save
    
    ' Сохраняем резервную копию
    ThisWorkbook.SaveCopyAs BackupFolder & "\Копия_от_" & Format(Now, "yyyy-mm-dd_hh-mm-ss") & ".xlsm"
End Sub

#VBA #ExcelVBA #Backup #РезервноеКопирование #MkDir

📄 Экспорт данных из Excel в PDF
Метод VBA Excel ExportAsFixedFormat позволяет сохранить лист, диапазон или весь файл в PDF.

📌 Примеры
🔹 В примерах для сохранения PDF-файлов используется папка «Test», созданная в корне диска «C».
🔹 При попытке экспортировать данные в существующий файл PDF произойдет ошибка. Если часто приходится сохранять данные в PDF, следует использовать динамическое формирование имени файла, как в предыдущем посте.

1️⃣ Экспорт одного листа:

Sub Primer1()
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Test\file1.pdf", OpenAfterPublish:=True
End Sub

🔹 Параметр OpenAfterPublish:=True указывает на то, что файл PDF должен быть открыт по окончании процесса экспорта.
🔹 Filename:="C:\Test\file1.pdf" - полное имя файла, куда будут сохранены экспортируемые в PDF данные.

2️⃣ Экспорт диапазона:

Sub Primer2()
    Лист1.Range("A1:F6").ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Test\file2.pdf", OpenAfterPublish:=True
End Sub

3️⃣ Экспорт группы листов, расположенных подряд:

Sub Primer3()
    ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Test\file3.pdf", _
    From:=2, To:=5, OpenAfterPublish:=True
End Sub

🔹 From:=2 и To:=5 - указывают на то, что будут экспортированы в PDF все листы со 2 по 5.

4️⃣ Экспорт группы листов, расположенных не подряд:

Sub Primer4()
    Sheets(Array("Лист2", "Лист3", "Лист5")).Select
    Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Test\file4.pdf", OpenAfterPublish:=True
End Sub

5️⃣ Экспорт всей книги:

Sub Primer5()
    ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Test\file5.pdf", OpenAfterPublish:=True
End Sub

#VBA #ExcelVBA #PDF #ExportAsFixedFormat #Экспорт

🖥 Вывод разрешения экрана

🛠 Вывод текущего разрешения экрана компьютера с помощью VBA Excel:

' Объявление API-функции для 64-разрядных платформ
Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As LongPtr) As LongPtr
    
' Объявление API-функции для 32-разрядных платформ
' Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Sub GetMonitorXY()
    MsgBox "Текущее разрешение экрана: " & GetSystemMetrics(0) & " x " & GetSystemMetrics(1)
End Sub

#VBA #ExcelVBA #GetSystemMetrics #РазрешениеЭкрана

✂️ Обрезание расширения файла

Подходит для файлов, в наименовании которых есть только одна точка, которая стоит перед расширением:

Sub RemoveFileExtension()
    If InStr(ThisWorkbook.Name, ".") > 1 Then
        MsgBox "Имя файла с расширением: " & ThisWorkbook.Name & vbNewLine & _
        "Имя файла без расширения: " & Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1)
    End If
End Sub

#VBA #ExcelVBA #Расширение #Extension

📖 Вывод списка листов
Выводим список всех листов текущей книги, включая листы диаграмм, в MsgBox и в первый столбец активного листа.

1️⃣ Вывод списка листов в MsgBox:

Sub SheetsToMsgBox()
Dim mySheet As Object, s As String
    For Each mySheet In Sheets
        s = s & mySheet.Name & vbNewLine
    Next
MsgBox s
End Sub

2️⃣ Вывод списка листов в первый столбец активного листа:

Sub SheetsToRange()
Dim mySheet As Object, i As Integer
    For Each mySheet In Sheets
        i = i + 1
        Cells(i, 1) = mySheet.Name
    Next
End Sub

#VBA #ExcelVBA #СписокЛистов

🏃‍♀️ Бегущая строка
Следующий код VBA Excel создаст бегущую строку в указанной ячейке (в примере - Cells(1, 1)).

🛠 Можно задавать:
🔹 Свой текст бегущей строки
🔹 Расстояние между двумя бегущими строками
🔹 Количество пробежавших строк до остановки процедуры
🔹 Скорость бегущей строки
🔹 Ячейку, в которой побежит строка

Код бегущей строки:

Sub BegushchayaStroka()
Dim stroka1 As String, stroka2 As String, yacheyka As Range, _
probely As Integer, dlina As Integer, kolichestvo As Integer, _
zaderzhka As Single, start As Single, i1 As Integer, i2 As Integer
 
stroka1 = "Моя бегущая строка" 'Текст бегущей строки
probely = 25 'Расстояние между бегущими строками
kolichestvo = 3 'Количество пробежавших строк
zaderzhka = 0.05 'Регулирует скорость бегущей строки
Set yacheyka = Cells(1, 1) ' Ячейка с бегущей строкой
 
stroka1 = Space(probely) & stroka1
dlina = Len(stroka1)
    With yacheyka
        .Value = stroka1
        .EntireColumn.AutoFit
    End With
    For i1 = 1 To kolichestvo
        For i2 = 1 To dlina
        stroka2 = Right(stroka1, dlina - i2) & Left(stroka1, i2)
        yacheyka.Value = stroka2
            start = Timer
            Do While Timer < start + zaderzhka
               DoEvents
            Loop
        Next
    Next
End Sub

#VBA #ExcelVBA #БегущаяСтрока