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

Сохранить файл Excel в другом формате

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

Например, вы работаете с книгой Excel в формате Excel 97-2003 (расширение XLS), и вам понадобилось преобразовать этот файл в формат «двоичная книга Excel» (расширение XLSB)

Для чего это нужно? К примеру, файлы в формате XLSB занимают намного меньше места на диске, и не будут открываться в Excel 2007 и новее в режиме совместимости (еслои вам вдруг перестало хватать 65 тысяч строк)

Поместите этот макрос в любую из подключенных надстроек Excel (или в личную книгу макросов Personal.xlsb), и назначьте этот макрос кнопке на панели быстрого вызова:

Вывод списка фигур на листе Excel с их координатами

Данный макрос производит поиск фигур (графических объектов) на всех листах текущей книги Excel,
и выводит следующую информацию по каждой найденной фигуре:

  • Название фигуры (графического объекта)
  • Координаты верхнего левого угла
  • Координаты правого нижнего угла
  • Размеры фигуры (ширина, высота)
  • Тип фигуры (свойство Type типа MsoShapeType)
  • Тип автофигуры (свойство AutoShapeType типа MsoAutoShapeType)

Вывод информации производится в окно Immediate

Экспорт таблицы (диапазона ячеек) в CSV

Часто при формировании прайс-листов требуется выгрузить большой объём данных в текстовый файл в формате CSV (разделитель - точка с запятой, или запятая)
И далеко не всегда может помочь сохранение файла в этом формате, поскольку в выгрузку попадают лишние данные (заголовки таблиц, лишние строки и столбцы, и т.д.)

В данном случае поможет экспорт заданного диапазона ячеек в файл CSV, что проще всего сделать макросом с использованием функции Range2CSV:

Sub ЭкспортПрайсЛистаВФорматеCSV()
    On Error Resume Next
    Dim sh As Worksheet: Set sh = ActiveSheet    ' обрабатывается активный лист

    ' диапазон ячеек с A5 до последней заполненной ячейки в столбце A
    ' расширенный по горизонтали на 10 столбцов (выгружаются столбцы с A по J)
    Dim ra As Range: Set ra = sh.Range(sh.[A5], sh.Range("A" & sh.Rows.Count).End(xlUp)).Resize(, 10)
 
    ' формируем текстовую строку, содержащую текст диапазона в формате CSV
    CSVtext$ = Range2CSV(ra, ";")    ' можно указать другой разделитель столбцов

    ' создаём в папке с файлом XLS подпапку для CSV-прайсов (если такой папки ещё нет)
    CSVfolder$ = ThisWorkbook.Path & "\CSV prices\": MkDir CSVfolder$
 
    ' формируем имя создаваемого файла CSV (c указанием текущей даты)
    CSVfilename$ = Format(Now, "YYYY MM DD  HH-NN-SS") & ".csv"
 
    ' сохраняем текстовую CSV-строку CSVtext$ в файл с именем CSVfilename$
    SaveTXTfile CSVfolder$ & CSVfilename$, CSVtext$
End Sub

Воспроизведение звуков (проигрывание мелодий) макросом VBA

Соответствие клавиш клавиатуры компьютера нотам (как на клавиатуре баяна)

Самый простой вариант извлечь звук при помощи макроса VBA:

Shell "Cmd.exe /c echo " & Chr(7), vbHide

Эта команда вводит в консоль символ с кодом 7 (ввод этого символа вызывает звуковой сигнал)
Из спикера компьютера (не из динамиков!) прозвучит короткий однотональный звуковой сигнал.

Если же нужен звук подлиннее - то можно «ввести» в консоль несколько символов Chr(7).
Например, эта строка кода выдаст тройной звуковой сигнал:

Shell "Cmd.exe /c echo " & Chr(7) & Chr(7) & Chr(7), vbHide

Ниже приведён более сложный вариант - с использованием WinAPI (функции Beep).

Проверка синтаксиса адреса электронной почты на 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:

Чтение CSV файла в двумерный массив

Функция TextFile2Array предназначена для преобразования файла CSV в двумерный массив

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

Чтобы упростить весь процесс - от выбора файла CSV в диалоговом окне, до разбиения загруженного из файла текста в двумерный массив, и была написана эта функция.

В качестве параметров функции можно задать разделители строк и столбцов текстового файла, так что при помощи этой функции можно загружать данные не только из файлов CSV, но и из любых других текстовых файлов, имеющих аналогичную структуру. 

Пример использования функции для загрузки данных из файла CSV:

Sub ЗагрузкаДанныхИзCSV()
    ' выбор файла по умолчанию предлагается в той же папке,
    ' где расположен текущий файл Excel
    CSVarr = TextFile2Array(, ThisWorkbook.Path, , "*.csv")
 
    ' проверка результата загрузки данных (выход из макроса, если данные не загружены)
    If Not IsArray(CSVarr) Then MsgBox "Файл CSV не обработан", vbCritical, "Ошибка": Exit Sub
 
    ' ваш код обработки двумерного массива
    Debug.Print "Загружен двумерный массив размерами " & _
                UBound(CSVarr, 1) & " строк на " & UBound(CSVarr, 2) & " столбцов"
End Sub

Разбиение текстового файла (в т.ч. CSV) на несколько файлов с заданным количеством строк

Функция предназначена для разбивки текстового файла на несколько файлов меньшего размера - в каждом из которых будет не более заданнного количества строк

Разделитель строк (обычно это перевод строки - константа vbNewLine) задаётся в качестве параметра функции Delimiter$

Создаваемые файлы получают имена вида filename(1).txt, filename(2).txt и т.д.

Если задан параметр функции DeleteSourceFile равным TRUE, - то исходный файл удаляется после разделения

Функция возвращает коллекцию, содержащую пути к сформированным файлам

В начало каждого создаваемого файла дописывается строка заголовка - первая строка из исходного файла

 

Пример использования функции SplitTextFile:

Sub ПримерИспользованияФункции_SplitTextFile()
    ИмяРазбиваемогоФайла$ = "C:\test\2011 04 17  12-32-30.csv"
    МаксимальноеКоличествоСтрокВфайле& = 3
 
    Dim СписокИмёнФайлов As Collection
    Set СписокИмёнФайлов = SplitTextFile(ИмяРазбиваемогоФайла$, МаксимальноеКоличествоСтрокВфайле&, vbNewLine, False)
 
    For Each Файл In СписокИмёнФайлов
        Debug.Print "Создан файл: " & Файл
    Next
End Sub

Расширенная функция поиска на листе Excel

Функция производит поиск текстового значения в заданном диапазоне листа,
и возвращает диапазон, содержащий все найденные ячейки

Взято с сайта Чипа Пирсона: cpearson.com/excel/FindAll.aspx

Function FindAll(SearchRange As Range, _
                 FindWhat As Variant, _
                 Optional LookIn As XlFindLookIn = xlValues, _
                 Optional LookAt As XlLookAt = xlWhole, _
                 Optional SearchOrder As XlSearchOrder = xlByRows, _
                 Optional MatchCase As Boolean = False, _

Замена запрещённых символов в имени файла или папки

При попытке сохранить файл под именем, заданным пользователем, вы можете получить ошибку - если в имени файла (папки) присутствуют запрещённые символы.