mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

Макросы VBA Excel

Макрос округления массива (значений в заданном столбце)

Макрос предназначен для округления значений в заданном столбце массива, с заданной точностью и направлением округления

Sub Пример_Округления_Массива()
    Dim arr As Variant
 
    ' считываем данные из диапазона ячеек в массив
    arr = Range("a2:c20").value
 
    ' переводим весь второй столбец в числа (на всякий случай)
    For i = LBound(arr) To UBound(arr)
        arr(i, 2) = Val(Replace(arr(i, 2), ",", "."))
    Next i
 
    ' значения во втором столбце массива округляем до нуля знаков после запятой в бОльшую сторону
    RoundArray arr, 2, 0, 1
 
    ' выводим результат на 4 столбца правее
    Range("a2:c20").offset(, 4).value = arr
End Sub

Код функции округления:

Получение списка IP адресов средствами VBA

Фунцкия Get_All_IP_Addresses возвращает коллекцию, содержащую все IP-адреса всех сетевых интерфейсов.

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

Sub ВыводРезультатов_Get_All_IP_Addresses()
    For Each IPaddr In Get_All_IP_Addresses
        txt = txt & IPaddr & vbNewLine
    Next
    MsgBox txt, vbInformation, "Список всех IP адресов"
End Sub

Преобразование пути к сетевой папке в формат UNC

К примеру, требуется преобразовать путь вида Z:\Папка\Разное\ (где Z - буква сетевого диска) в путь вида \\server\Files\Папка\Разное

Для этого можно использовать возможности объекта FileSystemObject:

Sub ПолучениеСетевогоПутиПапки()
    ОбычныйПуть = "Z:\Папка\Разное\"
 
    With CreateObject("Scripting.FileSystemObject").getfolder(ОбычныйПуть)
        СетевойПуть = Replace(.Path, .Drive.Path, .Drive.ShareName)
    End With
 
    Debug.Print ОбычныйПуть, СетевойПуть
    ' СетевойПуть = \\server\Files\Папка\Разное
End Sub

Звонок из Excel через SIP софтфон Sippoint

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

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

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

Предлагаю вашему вниманию макрос, который позволит нажатием одной кнопки набрать номер телефона из ячейки в популярном софтфоне Sippoint (от компании SIPNET)

Sub ПозвонитьНаНомерИзВыделеннойЯчейкиExcel()
    ' макрос наберёт номер из активной ячейки в программе Sippoint
    CallWithSIPPOINT Trim(ActiveCell)
End Sub

Декодирование JSON (преобразование кодов символов в буквы)

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

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

Sub test_JSON_decode()
    ' исходная строка в кодировке JSON
    txt$ = "<th class=\""label\"">\u0428\u0442\u0440\u0438\u0445\u043a\u043e\u0434<\/th>\n    <td class=\""data\"">408<\/td>\n"
 
    Debug.Print JSON_decode(txt)
    ' на выходе получаем: <th class="label">Штрихкод</th>    <td class="data">408</td>
End Sub

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