Макросы VBA Excel — Страница 18

Подсчёт количества файлов и подпапок в заданной папке средствами VBA

Этот макрос выводит информацию о папке - например, её размер, и количество файлов в ней:

Sub ПодсчётКоличестваФайловВПапке()
    ' задаём папку
    FolderPath = "C:\Documents and Settings\Admin\Рабочий стол\"
 
    ' получаем характеристики папки
    Set FSO = CreateObject("Scripting.FileSystemObject")
    КоличествоФайловВПапкеБезУчётаПодпапок = FSO.GetFolder(FolderPath).Files.Count
    КоличествоПодпапок = FSO.GetFolder(FolderPath).SubFolders.Count
    РазмерПапкиВБайтах = FSO.GetFolder(FolderPath).Size
 
    ' подсчитываем количество файлов с учётом файлов в подпапках
    КоличествоФайловВПапкеСУчётомПодпапок = FilesCount(FolderPath)
 
    Debug.Print "В папке найдено " & КоличествоФайловВПапкеБезУчётаПодпапок & " файлов и " & _
                КоличествоПодпапок & " подпапок. Всего файлов: " & КоличествоФайловВПапкеСУчётомПодпапок
    Debug.Print "Папка занимает на диске " & РазмерПапкиВБайтах & " байтов (" & _
                FileOrFolderSize(РазмерПапкиВБайтах) & ")"
End Sub

Результат работы кода (в окне Immediate):

В папке найдено 186 файлов и 31 подпапок. Всего файлов: 4216
Папка занимает на диске 193158100 байтов (184 Мб)

Если же вам надо вывести список файлов на лист Excel - смотрите функцию FilenamesCollection:
http://excelvba.ru/code/FilenamesCollection

Надстройка для загрузки списка файлов на лист Excel

Скриншот формы поиска файлов в заданной папке

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

Автор: VictorM

Особенности надстройки:

задаваемая пользователем глубина поиска в подпапках
простановка гиперссылок на листе Excel на найденные файлы
вывод дополнительных характеристик файла
(размер файла, дата создания файла, полный путь)
изменяемая маска поиска (поиск по части имени файла, по расширению, и т.д.)
вывод результатов поиска на отдельный лист

Макросы для получения размера изображения, и создания уменьшенной копии картинки

В данной статье опубликованы макросы для уменьшения размеров изображения (в графическом файле),
и для получения размеров картинки из файла.

Эти макросы нашли применение в универсальной надстройке для вставки картинок в Excel

Там они используются для выполнения функции сжатия изображений перед вставкой
(сначала рассчитываются нужные размеры изображения на листе Excel,
затем создаётся уменьшенная копия исходной картинки (с заданными размерами),
и потом уже уменьшенная картинка вставляется на лист Excel)

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

Удаление "пустых строк" из массива

Удаление "пустых строк" из диапазона ячеек при помощи макроса

Function DeleteBlankRows(ByVal arr As Variant, ByVal col As Long) As Variant

Sub ПримерИспользования()
    On Error Resume Next
    arr = [a1:d15] ' считываем значения ячеек диапазона [a1:d15] в массив arr
    
    ' получаем массив arr2, в 5-м столбце которого нет пустых значений
    arr2 = DeleteBlankRows(arr, 5)
 
    [f1:z111].Clear ' очищаем диапазон ячеек [f1:z111] на листе
    
    ' вставляем массив без пустых строк обратно на лист
    [f1].Resize(UBound(arr2, 1), UBound(arr2, 2)).Value = arr2
End Sub

Автоподбор высоты объединённых ячеек

Предлагаю 2 варианта автоподбора высоты объединённых ячеек в Excel
(оба работаю не идеально, - но, тем не менее, в большинстве случаев и этого будет достаточно)

1 вариант: (разъединение, автоподбор, объединение)

Sub AutoFitMergeAreaSize(ByRef cell As Range)
    Dim ra As Range: Set ra = cell.MergeArea
    cell.UnMerge
    cell.EntireRow.AutoFit
    ra.Merge
End Sub
 
Sub ПримерИспользования_АвтоподборВысотыОбъединённойЯчейки()
    AutoFitMergeAreaSize ActiveCell
    AutoFitMergeAreaSize [d3]
End Sub

2 вариант:(то же самое, по сути, только кода побольше)