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

Макрос форматирования заголовка таблицы

Результат работы макроса форматирования заголовка таблицы

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

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

Что он делает: (действия выполняются с выделенным диапазоном ячеек)

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

 

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

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

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

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

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

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

Макрос отправки файла на файлообменник zalil.ru

Иногда требуется выложить некоторый файл в общий доступ, и поделиться ссылкой на него.

Для автоматизации этой задачи и предназначена функция UploadFile

Использование классов для элементов управления на форме

Скриншот формы VBA с программно созданными элементами управления

В прикреплённом файле - пример макроса для автоматического создания на форме элементов управления.

Благодаря использованию модуля класса, всем создаваемым элементам управления (в данном случае это CheckBox-ы) назначается один и тот же обработчик событий.

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

Код модуля класса:

Public WithEvents CheckBox As MSForms.CheckBox
 
Public MPname As String
Public MPindex As Integer
Public Index As Integer
 
Sub CheckBox_Change()
    msg = "Изменено состояние чекбокса номер  " & Me.Index & vbNewLine & vbNewLine
    msg = msg & "на вкладке  " & Me.MPname & "   (индекс вкладки = " & Me.MPindex & ")" _
          & vbNewLine & vbNewLine & vbNewLine
    msg = msg & "Новое состояние:  " & Me.CheckBox.Value
    MsgBox msg, vbInformation, "Вы изменили состояние чекбокса!"
End Sub

Диалоговое окно выбора цвета (функция VBA для запроса цвета заливки)

Настройки цвета заливки на форме VBA

Данная функция позволяет запрашивать у пользователя цвет заливки.

Функция возвращает целое число - значение цвета в формате RGB

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

Sub ОкраскаЯчейкиВВыбранныйЦвет()
    On Error Resume Next
    DefaultColor& = vbRed    ' цвет по-умолчанию
    NewColor& = PickNewColor(DefaultColor&)    ' выбираем новый цвет
    
    ActiveCell.Interior.Color = NewColor&    ' красим активную ячейку
End Sub

Код функции:

Function PickNewColor(Optional ByVal i_OldColor As Double = xlNone) As Double
    ' функция отображает диалоговое окно выбора цвета заливки
    ' и возвращает значение выбранного цвета
    On Error Resume Next:
    PickNewColor = i_OldColor
    Const BGColor As Long = 13160660, ColorIndexLast As Long = 32
    Dim myOrgColor As Double, myNewColor As Double, WB As Workbook
    Dim myRGB_R As Integer, myRGB_G As Integer, myRGB_B As Integer
    If ActiveWorkbook Is Nothing Then Application.ScreenUpdating = False: Set WB = Workbooks.Add
    myOrgColor = ActiveWorkbook.Colors(ColorIndexLast)    'save original palette color

    i_Color = IIf(i_OldColor = xlNone, BGColor, i_OldColor): myRGB_R = i_Color Mod 256
    i_Color = i_Color \ 256: myRGB_G = i_Color Mod 256
    i_Color = i_Color \ 256: myRGB_B = i_Color Mod 256
    ActiveWorkbook.ResetColors    'AppActivate Application.Name
    If Application.Dialogs(xlDialogEditColor).Show(ColorIndexLast, myRGB_R, myRGB_G, myRGB_B) Then
        PickNewColor = ActiveWorkbook.Colors(ColorIndexLast)
        ThisWorkbook.Colors(ColorIndexLast) = myOrgColor
    End If
    If Not WB Is Nothing Then WB.Close False: Application.ScreenUpdating = True
End Function