Главная » Макросы VBA Excel

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

Проверка синтаксиса адреса электронной почты на VBA

В макросах для Excel иногда требуется производить проверку адреса электронной почты на корректность.

В большинстве случаев нужно быть уверенным не только в том, что такой адрес содержит знак @ и точку, но и в том, что все остальные символы представлены буквами, числами или знаками подчеркивания.
Проще всего реализовать эту проверку с использованием регулярных выражений (объект RegExp) 

Sub ПримерПроверкиАдресаПочты()
    Debug.Print CheckEmail("order@ExcelVBA.ru")    ' возвращает TRUE (корректный адрес почты)
    Debug.Print CheckEmail("123-order@ExcelVBA.ru")    ' возвращает TRUE (корректный адрес почты)
    Debug.Print CheckEmail("create.order@Excel.VBA.ru")    ' возвращает TRUE (корректный адрес почты)
    Debug.Print CheckEmail("mail@Excel-macro.ru")    ' возвращает TRUE (корректный адрес почты)

    Debug.Print CheckEmail("order@ExcelVBA")    ' возвращает FALSE (ошибка в адресе почты)
    Debug.Print CheckEmail("order.ExcelVBA.ru")    ' возвращает FALSE (ошибка в адресе почты)
    Debug.Print CheckEmail("order.ExcelVBA@ru")    ' возвращает FALSE (ошибка в адресе почты)
End Sub

Используемый в функции шаблон может принимать любое количество цифр и букв, символов подчеркивания, точки и тире перед знаком «@» и после символа «@» до точки, но только числа, буквы и символы подчеркивания после точки.

Код функции CheckEmail:

Подсчёт количества файлов и подпапок в заданной папке средствами 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,
затем создаётся уменьшенная копия исходной картинки (с заданными размерами),
и потом уже уменьшенная картинка вставляется на лист 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

Вывод списка имён (Names) книги Excel на новый лист

Если вы хотите посмотреть, присутствуют ли в книге Excel назначенные имена,