🔳 Метод 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 #БегущаяСтрока

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

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 #пункт #символ