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

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

Предлагаю 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 вариант:(то же самое, по сути, только кода побольше)

Авторизация на Яндексе с использованием WinHttpRequest

Приведённый ниже код выполняет авторизацию на Яндексе, отправляя GET и POST запрос

Преобразование массива в XML (экспорт таблицы в файл XML)

Функция Array2XML формирует из исходной таблицы объект типа DOMDocument, который можно выгрузить в XML-файл одной строкой кода (метод Save)

Sub XMLExport()
    Dim Заголовок As Range, Данные As Range
    Set Заголовок = Range("a1:f1")
    Set Данные = Range([A2], Range("A" & Rows.Count).End(xlUp)).Resize(, Заголовок.Columns.Count)
 
    arrHeaders = Application.Transpose(Application.Transpose(Заголовок.Value))
    ПутьКФайлуXML = ThisWorkbook.Path & "\result.xml"
 
    ' формируем DOMDocument, и сохраняем XML в файл result.xml
    Array2XML(Данные.Value, arrHeaders, "Root").Save ПутьКФайлуXML
 
    If Err = 0 Then MsgBox "Создан XML файл" & vbNewLine & ПутьКФайлуXML, vbInformation, "Готово"
End Sub

Функция PING на VBA с изменяемым размером ICMP пакета

Function Ping(ByVal addr$) As Boolean
    On Error Resume Next
    Ping = GetObject("winmgmts:").ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = '" & addr$ & "'").ItemIndex(0).StatusCode = 0
End Function

Функция проверки доступа в интернет, с использованием функции PING (версия 2024 года)

Function InetAvailable() As Boolean
    InetAvailable = Ping("bing.com"): If Not InetAvailable Then InetAvailable = Ping("google.com")
End Function

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

Sub TestPingFunction()
    If Ping("ComputerName") Then ПутьКПапке = "\\ComputerName\files"
    If Ping("ya.ru") Then MsgBox "Интернет доступен!"
    If Not Ping("192.168.0.2") Then MsgBox "Компьютер с IP адресом 192.168.0.2 недоступен в сети!"
End Sub

Определение IP адреса и страны по доменному имени

Макрос определения страны и IP адреса по доменному имени

Макрос предназначен для вывода IP адресов и названий стран, на основании столбца с доменными именами.

По состоянию на 2024 год, этот макрос не работает ввиду недоступности сайта smart-ip.net (можно переделать код на использование другого аналогичного веб-сервиса)

В прикреплённом файле - 2 способа реализации:

1) по доменному имени определяется IP адрес (посредством команды PING - выполнения ICMP запроса),
а затем определяется страна (по IP адресу), с использованием сервиса smart-ip.net

2) используется только сервис smart-ip.net
Отправляется запрос на указанный сервис, и из полученных данных вычленяются IP адрес и название страны.