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

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

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

Функция 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

Авторизация на Яндексе с использованием 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

Получение MD5 хэша в VBA

Во вложенном файле представлен вариант функции для получения MD5 хэша строки без использования .Net Framework
(чистый VBA, то есть будет работать на любом компьютере)