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

Функция перевода ФИО в родительный падеж

Пользовательская функция (UDF) для перевода ФИО (фамилии, имя, отчества) в родительный падеж.

Новые версии функций (изменения от 2019 года) доступны в надстройке FIO + Propis

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

PS: Функция является переделкой аналогичной UDF для склонения в дательном падеже.
Тестировал склонение на списке разнообразных ФИО (см. первый столбец в прикреплённом файле), и заведомо корректных результатах склонения (третий столбец)

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

Если вы используете функции склонения для формирования документов,
обратите внимание на специализированную надстройку FillDocuments,
которая позволит вам одним нажатием кнопки создать документы Word и Excel по шаблонам, а также выполнить рассылку писем.

В указанную надстройку включены самые последние версии функций склонения.

Пример использования:

Sub ПереводФИОвРодительныйПадеж()
    ' если фамилия, имя и отчество - в одной переменной (или ячейке)
    FIO$ = "Сидоров Иван Скотиныч"
    РодительныйПадеж$ = GenitiveCase(FIO$)
    Debug.Print РодительныйПадеж$    ' результат: Сидорова Ивана Скотиныча

    ' если фамилия, имя и отчество - в разных переменных (или ячейках)
    НетКого$ = GenitiveCase("Андреева", "Ольга", "Федоровна")
    Debug.Print НетКого$    ' результат: Андреевой Ольги Федоровны
End Sub

Код функции GenitiveCase (версия от 29 января 2013 года):

Скачивание исходного кода web-страницы в текстовый файл

Данная функция возвращает исходный текст web-страницы:

Function GetHTTPResponse(ByVal sURL As String) As String
    On Error Resume Next
    Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
    With oXMLHTTP
        .Open "GET", sURL, False
        ' раскомментируйте следующие строки и подставьте верные IP, логин и пароль
        ' если вы сидите за proxy
        ' .setProxy 2, "192.168.100.1:3128"
        ' .setProxyCredentials "user", "password"
        .send
        GetHTTPResponse = .responseText
    End With
    Set oXMLHTTP = Nothing
End Function

Извлечение уникальных значений из диапазона ячеек или массива

Функция UniqueValuesFromArray позволяет найти в указанном столбце двумерного массива все уникальные значения, и получить новый массив, содержащий все найденные уникальные значения.
Это может пригодиться, если надо, к примеру, заполнить ComboBox на форме возможными вариантами значений из базы данных:

Private Sub UserForm_Initialize()
    On Error Resume Next: arr = PriceRange.Value
    If Err Then MsgBox "Нет строк для обработки!", vbCritical, "Ошибка": End
 
    ' заполняем комбобокс уникальными значениями из 6-го столбца таблицы
    Me.ComboBox_Source.List = UniqueValuesFromArray(arr, 6)
End Sub

Сохранить изображения с листа Excel в файлы

Сохранить все изображения с листа в файлы

Надстройка позволяет экспортировать все изображения с листа Excel в графические файлы.

Функция VBA для выполнения веб-запроса (Web Query)

Функция GetQueryRange предназначена для автоматизации загрузки данных с веб-страниц.

Например, нам надо из макроса Excel получить данные с нескольких однотипных страниц сайта.

Самый простой способ достичь этого - выполнять почти идентичные веб-запросы (где незначительно отличаться будет только URL страницы),
каждый раз анализируя данные, загруженные веб-запросом на лист Excel

Поскольку количество обращений ко мне, с просьбами сделать программу загрузки данных из интернета, с каждым днём растёт, я решил сделать для этих целей универсальную функцию:

Sub ПримерИспользования()
    Dim ra As Range: On Error Resume Next
 
    Set ra = GetQueryRange("http://ExcelVBA.ru/", 6)
    Debug.Print ra.Address    ' переменная ra содержит ссылку на диапазон ячеек $A$1:$C$15,
    ' содержащий данные 6-й таблицы главной страницы сайта ExcelVBA.ru

    Set ra = GetQueryRange("http://excelvba.ru/sitemap.xml")
    Debug.Print ra.Address    ' теперь переменная ra содержит ссылку на диапазон ячеек $A$1:$D$502,
    ' содержащий данные карты сайта ExcelVBA.ru

End Sub