👌 Список подключенных библиотек
В окне «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 #БегущаяСтрока

📅 Вывод текущей даты и времени

1️⃣ Вывод текущей даты в формате "Short Date":

Sub OutputShortDateTime()
MsgBox "Привет!" & vbNewLine & "Сегодня " & WeekdayName(Format(Now, "w", vbMonday)) _
& " " & Format(Now, "Short Date") & " года" & vbNewLine & "Время: " & Format(Now, "Short Time")
End Sub

2️⃣ Вывод текущей даты в полном формате и приветствия в соответствии со временем суток:

Sub OutputLongDateTime()
Dim pr As String, ms As String
    If TimeValue(Time) > TimeValue("9:00") And TimeValue(Time) <= TimeValue("15:00") Then
        pr = "Добрый день!"
    ElseIf TimeValue(Time) > TimeValue("15:00") And TimeValue(Time) <= TimeValue("21:00") Then
        pr = "Добрый вечер!"
    ElseIf TimeValue(Time) > TimeValue("21:00") And TimeValue(Time) <= TimeValue("3:00") Then
        pr = "Доброй ночи!"
    Else
        pr = "Доброе утро!"
    End If
ms = Choose(Month(Now), "января", "февраля", "марта", "апреля", "мая", "июня", "июля", _
"августа", "сентября", "октября", "ноября", "декабря")
MsgBox pr & vbNewLine & "Сегодня " & WeekdayName(Format(Now, "w", vbMonday)) _
& " " & Day(Now) & " " & ms & " " & Year(Now) & " года" & vbNewLine & "Время: " & Format(Now, "Short Time")
End Sub

#VBA #ExcelVBA #Date #Time #Дата #Время

📂 Просмотр содержимого папки в VBA Excel
Если вам нужно получить список подпапок или файлов из определенной папки в Excel, VBA легко справится с этой задачей!

1️⃣ Просмотр подпапок в выбранной папке:

Sub ПросмотрПапок()
    Dim ws As Worksheet
    Dim FSO As Object
    Dim FolderPath As String
    Dim SubFolder As Object
    Dim FolderDialog As Object
    Dim Row As Integer
    
    ' Выбор папки через диалоговое окно
    Set FolderDialog = Application.FileDialog(4) ' 4 – выбор папки
    If FolderDialog.Show = -1 Then
        FolderPath = FolderDialog.SelectedItems(1)
    Else
        Exit Sub
    End If

    ' Работа с подпапками
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set ws = ThisWorkbook.Sheets(1)
    
    ws.Cells.Clear ' Очистка листа перед вставкой данных
    ws.Cells(1, 1).Value = "Папки в: " & FolderPath
    ws.Cells(2, 1).Value = "Имя папки"
    
    Row = 3
    For Each SubFolder In FSO.GetFolder(FolderPath).SubFolders
        ws.Cells(Row, 1).Value = SubFolder.Name
        Row = Row + 1
    Next SubFolder
    
    MsgBox "Просмотр завершен! Найдено " & Row - 3 & " папок.", vbInformation, "Готово"
    
End Sub

🔹 Как это работает?
✅ Открывается диалоговое окно для выбора папки 📁
✅ Код перебирает файлы в выбранной папке и записывает их имена на лист Excel 📜
✅ Показывается сообщение о завершении работы 🚀

2️⃣ Просмотр файлов в выбранной папке:

Sub ПросмотрФайлов()
    Dim ws As Worksheet
    Dim FSO As Object
    Dim FolderPath As String
    Dim FileItem As Object
    Dim FolderDialog As Object
    Dim Row As Integer
    
    ' Выбор папки через диалоговое окно
    Set FolderDialog = Application.FileDialog(4) ' 4 – выбор папки
    If FolderDialog.Show = -1 Then
        FolderPath = FolderDialog.SelectedItems(1)
    Else
        Exit Sub
    End If

    ' Работа с файлами в папке
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set ws = ThisWorkbook.Sheets(1)
    
    ws.Cells.Clear ' Очистка листа перед вставкой данных
    ws.Cells(1, 1).Value = "Файлы в папке: " & FolderPath
    ws.Cells(2, 1).Value = "Имя файла"
    
    Row = 3
    For Each FileItem In FSO.GetFolder(FolderPath).Files
        ws.Cells(Row, 1).Value = FileItem.Name
        Row = Row + 1
    Next FileItem
    
    MsgBox "Просмотр завершен! Найдено " & Row - 3 & " файлов.", vbInformation, "Готово"
    
End Sub

🔹 Как работает этот код?
✅ Открывает диалоговое окно для выбора папки 📂
✅ Перебирает папки внутри выбранной директории и выводит их список на лист Excel 📜
✅ Показывает уведомление о завершении 🚀

#VBA #ExcelVBA #GetFolder #SubFolders #Files

〰️💲Тильда и знак доллара перед именем файла
Иногда, при просмотре списка файлов, можно обнаружить тильду со знаком доллара (~$) перед именем файла.

Файл с именем ~$Книга1.xlsm (с тильдой и знаком доллара в начале) – это временный (скрытый) файл, который Excel автоматически создает при открытии основного файла Книга1.xlsm.

🔍 Что означает этот значок?
🔹 ~$ – это префикс, который Excel использует для обозначения временных файлов.
🔹 Книга1.xlsm – оригинальное имя файла, к которому относится этот временный файл.

📌 Для чего нужен этот файл?
🔹 Блокировка файла – предотвращает одновременное редактирование не одним пользователем.
🔹 Временное хранение данных – помогает восстановить файл в случае сбоя.
🔹 Хранение информации о пользователе – если другой пользователь попробует открыть файл в сети, Excel покажет сообщение, что файл уже открыт кем-то другим.

🔄 Когда он исчезает?
Обычно этот файл удаляется автоматически после закрытия Excel. Но если Excel завершился некорректно (например, произошел сбой), временный файл может остаться в папке.

🛠 Что делать, если он не исчезает?
🔹 Закройте все экземпляры Excel.
🔹 Проверьте, не открыт ли основной файл.
🔹 Перезагрузите компьютер.
🔹 Если файл остался и мешает, его можно удалить вручную.

💡 Вывод
Файлы с префиксом ~$ не нужно трогать во время работы Excel – это его рабочие файлы. Если они остаются после закрытия, можно их удалить вручную. 🚀

#Prefix #Префикс #Тильда #ЗнакДоллара

📅 Заполнение ComboBox названиями месяцев
Три способа заполнения поля со списком (ComboBox) названиями месяцев.

📌 Примеры

1️⃣ Загружаем в ComboBox список месяцев на русском языке, по умолчанию отображаем Январь:

Private Sub UserForm_Initialize()
    With ComboBox1
        .List = Array("Январь", "Февраль", "Март", "Апрель", "Май", "Июнь", _
            "Июль", "Август", "Сентябрь", "Октябрь", "Ноябрь", "Декабрь")
        .Value = "Январь"
    End With
End Sub

Если же необходимо загрузить в ComboBox названия месяцев на языке пользователя, используем 2 и 3 примеры.

2️⃣ Загружаем в ComboBox список месяцев на языке пользователя, по умолчанию отображаем первый месяц:

Private Sub UserForm_Initialize()
    With ComboBox1
        .List = Array(MonthName(1), MonthName(2), MonthName(3), MonthName(4), _
            MonthName(5), MonthName(6), MonthName(7), MonthName(8), _
            MonthName(9), MonthName(10), MonthName(11), MonthName(12))
        .Value = MonthName(1)
    End With
End Sub

3️⃣ То же самое, что и во втором примере, но с помощью цикла:

Private Sub UserForm_Initialize()
Dim i As Byte
    With ComboBox1
        For i = 1 To 12
            .AddItem MonthName(i)
        Next
            .Value = MonthName(1)
    End With
End Sub

#VBA #ExcelVBA #ComboBox #AddItem #List #MonthName

🔲 Создание квадратной ячейки
Квадратную ячейку в Excel можно сделать вручную , выбрав ширину и высоту с одинаковым количеством пикселей. Но как это сделать программно?

В VBA Excel нет прямого способа задать ширину столбцов и высоту строк в пикселях, так как Excel использует свои собственные единицы измерения: для ширины столбцов — это количество символов стандартного шрифта, а для высоты строк — пункты (points). Однако можно приблизительно перевести пиксели в эти единицы.

🔹 Высота строки в Excel измеряется в пунктах (points). Один пункт равен примерно 1.33 пикселя.
🔹 Ширина столбца в Excel измеряется в количестве символов стандартного шрифта. Один символ стандартного шрифта равен примерно 7 пикселям.

📌 Пример

Sub SquareCell()
    With Range("A1")
        .EntireRow.RowHeight = 100 / 1.33
        .EntireColumn.ColumnWidth = 100 / 7
    End With
End Sub

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

#VBA #ExcelVBA #RowHeight #ColumnWidth #пункт #символ

📋 Создание выпадающего списка в ячейке Excel
Выпадающие списки в ячейках Excel помогают ограничить ввод данных и ускорить работу с таблицами. Их можно создать вручную через "Проверку данных", но VBA позволяет сделать это автоматически.

📌 Примеры

1️⃣ Простой выпадающий список для ячейки A1

Sub AddDropDownList()
    With Range("A1").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="Кофе,Чай,Сок,Молоко,Какао"
    End With
End Sub

✅ Что делает этот код?
🔹 Удаляет старые правила (.Delete).
🔹 Создает выпадающий список в ячейке A1 с вариантами: Кофе, Чай, Сок, Молоко, Какао.

2️⃣ Создание выпадающего списка на основе диапазона

Sub DropDownFromRange()  
    With Range("A1").Validation  
        .Delete  
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
             Operator:=xlBetween, Formula1:="=B1:B5"  
    End With  
End Sub

✅ Теперь при изменении значений в B1:B5 список обновится автоматически!

3️⃣ Создание динамического выпадающего списка

Sub DynamicDropDown()
    ActiveWorkbook.Names.Add Name:="Список", RefersTo:="=B1:INDEX(B:B,COUNTA(B:B))"
    With Range("A1").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
             Operator:=xlBetween, Formula1:="=Список"
    End With
End Sub

✅ Динамический список автоматически расширится при добавлении новых значений в колонку B.

4️⃣ Удаление выпадающего списка

Sub RemoveDropDown()
    Range("A1").Validation.Delete
End Sub

#VBA #ExcelVBA #Validation #ВыпадающийСписок

✨ Удаление пустых строк 2
Простое, но действенное, удаление пустых строк на всем листе по пустым ячейкам заданного столбца. Будут удалены и те строки, в которых есть значения в других столбцах.

📌 Пример

Sub DeleteEmptyRows()
    On Error Resume Next
        Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
End Sub

#VBA #ExcelVBA #ПустыеСтроки #EmptyRows #УдалениеПустыхСтрок

✨ Простое удаление дубликатов

📌 Примеры

1️⃣ Удаление дубликатов из списка в одном столбце

Sub RemoveDuplicates1()
    ActiveSheet.Range("A1:A20").RemoveDuplicates Columns:=Array(1)
End Sub

2️⃣ Удаление строк с дубликатами из таблицы

Sub RemoveDuplicates2()
    ActiveSheet.Range("A1:D20").RemoveDuplicates Columns:=Array(3), Header:=xlYes
End Sub

🔹 Из таблицы будут удалены строки, в которых есть повторы значений в заданном столбце (Columns:=Array(3)).
🔹 В параметре Columns может быть задано несколько столбцов, через запятую, для проверки наличия дубликатов в нескольких столбцах. Например: (Columns:=Array(1, 2)).
🔹 Header:=xlYes указывает на то, что в таблице есть заголовки, которые не должны учитываться при поиске дубликатов.

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

✨ Отбор уникальных значений из списка
Нетрадиционный способ отбора уникальных значений из списка в VBA Excel. Используем объект Dictionary.

📌 Примеры

1️⃣ Отбор уникальных значений из столбца A и выгрузка их на рабочий лист в столбец B:

Sub Primer1()
Dim myDictionary As Object, myCell As Range, myElement As Variant
    Set myDictionary = CreateObject("Scripting.Dictionary")
        'Отбор уникальных значений из списка в столбце A
        For Each myCell In Range("A1:A20")
          myElement = myDictionary.Item(CStr(myCell))
        Next
    'Выгрузка уникальных значений на рабочий лист в столбец B
    Range("B1").Resize(myDictionary.Count) = Application.Transpose(myDictionary.Keys)
End Sub

Как работает этот код?
🔹 При присвоении переменной myElement значения myDictionary.Item(CStr(myCell)) с несуществующем ключом, значение myCell записывается как ключ, а как значение записывается Empty, которое и присваивается переменной myElement.
🔹 Если значение myCell повторяется, оно игнорируется, так как все ключи в myDictionary должны быть уникальными.
🔹 Списком уникальных значений является полученный список ключей словаря (myDictionary.Keys), которые мы выгружаем на рабочий лист в колонку B.
🔹 Транспонирование (Application.Transpose) необходимо для того, чтобы горизонтальный список ключей словаря вставить в вертикальный список в столбце B.

2️⃣ Отбор уникальных значений из столбца A и выгрузка их в поле со списком (ComboBox):

Sub Primer2()
Dim myDictionary As Object, myCell As Range, myElement As Variant
    Set myDictionary = CreateObject("Scripting.Dictionary")
        'Отбор уникальных значений из списка в столбце A
        For Each myCell In Range("A1:A20")
          myElement = myDictionary.Item(CStr(myCell))
        Next
    'Выгрузка уникальных значений в поле со списком
    With UserForm1
        .ComboBox1.List = myDictionary.Keys
        .Show
    End With
End Sub

#VBA #ExcelVBA #Dictionary #ОтборУникальных #УникальныеЗначения #ComboBox

📖 Создание оглавления
Автоматическое создание оглавления (содержания) для всех листов в рабочей книге Excel с помощью VBA.

👍 Если у вас в файле много листов, можно создать оглавление, где каждая строка — это ссылка на определенный лист. Такой список поможет быстро переключаться между страницами. Кроме того, в соседнем столбце можно разместить какие-либо комментарии к соответствующему листу.

📌 Код VBA Excel:

Sub CreateTableOfContents()
    Dim ws As Object, toc As Object
    Dim i As Integer
    
    ' Удаляем старый лист "Оглавление", если он уже существует
    On Error Resume Next
        Application.DisplayAlerts = False
            Sheets("Оглавление").Delete
        Application.DisplayAlerts = True
    On Error GoTo 0

    ' Создаем новый лист "Оглавление"
    Set toc = Sheets.Add(Before:=Sheets(1))
    toc.Name = "Оглавление"
    
    ' Заголовок
    toc.Cells(1, 1).Value = "Оглавление"
    toc.Cells(1, 1).Font.Bold = True
    toc.Cells(1, 1).Font.Size = 14

    ' Добавляем ссылки на листы
    i = 2
    For Each ws In ThisWorkbook.Sheets
        If ws.Name <> "Оглавление" Then
            toc.Cells(i, 1).Value = ws.Name
            toc.Hyperlinks.Add Anchor:=toc.Cells(i, 1), _
                Address:="", SubAddress:="'" & ws.Name & "'!A1", _
                TextToDisplay:=ws.Name
            i = i + 1
        End If
    Next ws

    ' Автоширина столбца
    toc.Columns("A").AutoFit

    MsgBox "Оглавление создано!", vbInformation, "Готово!"
End Sub

📌 Как работает макрос?
🔹 Создает новый лист "Оглавление".
🔹 Записывает список всех листов.
🔹 Добавляет гиперссылки для перехода.

#VBA #ExcelVBA #Оглавление #Содержание #Hyperlinks #SubAddress