Создание пользовательских элементов управления в Экселе: красивые чек-боксы

Привет!
Сегодня покажу, как сделать собственные чек-боксы. Для наглядности посмотри несколько наборов, которые создал я:

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

Файл с примером прилагаю:

Менеджер создания чек-боксов.xlsm







Итак, качай файл с примером. В самом файле есть несколько элементов управления, включая сами чеки, которые ты создаешь. Для начала можешь попробовать нажимать на чеки, и ты сразу увидишь результат -- изменение значений в привязанных к чекам ячейках. При установленной птичке = 1, если птичку убрать = 0.

Кнопка: "ДОБАВИТЬ чек-боксы" добавляет внизу существующих еще выбранное тобой количество чек-боксов, каждый из которых по по дизайну соответствует нижнему из существующих чеков. Обращаю твое внимание, что целевые ячейки при этом еще не будут = 1. Для этого можно либо вставить 1-цы вручную, либо "поклацать" чеки.

Кнопка "УДАЛИТЬ чек-боксы, кроме первого" важна для пытливых разработчиков. Нажав ее, ты сможешь, зажав [Ctrl] клацнуть по рамке, или птичке и изменить их дизайн на свой. Имеется ввиду форма. Ведь для изменения цвета предусмотрен другой способ.

Изменение цвета

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

↑ Интерфейс понятен интуитивно. Просто жми на все подряд и проверяй результат =)

Заставить их работать!

Ну и время выложить код. Как ты знаешь, картинки в Экселе сами не реагируют на нажатие. Поэтому для работы чеков, тебе придется использовать код VBA. Для начала код, который срабатывает при нажатии:

Option Explicit

Sub чек()
'

    Dim Verh, sha As Shape, CorD, CorU, Sname As String
    Verh = ВерхняяКоординатаМыши()
    Dim sh As Worksheet
    Set sh = ActiveSheet
    Dim ChRN As String, Num As Long
    
    For Each sha In sh.Shapes
        If sha.Name Like "рамка*" Then
            CorU = sha.Top
            CorD = sha.Top + sha.Height
            If Verh >= CorU And Verh <= CorD Then
                Sname = sha.Name
            End If
        End If
    Next sha
    If Sname = "" Then Exit Sub
    
    Num = WorksheetFunction.Substitute(Sname, "рамка", "")
    Sname = "чек" & Num
    
    ChRN = "A" & 1 + Num 'поменять на свою целевую клетку
    
    If ActiveSheet.Shapes.Range(Array(Sname)).Visible Then
    ActiveSheet.Shapes.Range(Array(Sname)).Visible = msoFalse
    Range(ChRN) = 0
    Else
    ActiveSheet.Shapes.Range(Array(Sname)).Visible = msoTrue
    Range(ChRN) = 1
    End If
End Sub

В коде есть строка с отсылкой на целевую ячейку, в которой чек ставит 1 или 0:

ChRN = "A" & 1 + Num

В ней ты можешь поменять колонку "А" на свою, а так же поменять индекс с единицы на свое число. Индекс соответствует смещению вниз по строкам.

Потом код, который назначает макросы:

Sub НазначитьМакросы()


    Dim sha As Shape
    Dim sh As Worksheet
    Set sh = ActiveSheet
    
    For Each sha In sh.Shapes
        If sha.Name Like "рамка*" Or sha.Name Like "чек*" Then
            sha.OnAction = "чек"
        End If
    Next sha

End Sub 

Для корректной работы тебе нужно всего один раз запустить макрос "НазначитьМакросы":

1.  Жми Alt + F8
2. Выбери макрос из списка и жми Выполнить

Но не все так просто. Макрос "Чек" использует процедуру определения положения курсора на листе Эксель. Это нужно для того, чтобы определить, на какой именно чек ты нажимаешь. Чтобы код сработал в твоей книге Эксель, тебе дополнительно необходимо:

1. добавить новый модуль в редакторе VBA
2. скопировать туда представленный ниже текст:

Private Declare Function GetDC _
Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetDeviceCaps _
Lib "Gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function ReleaseDC _
Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Declare Function GetCursorPos _
Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
Declare Function GetKeyState _
Lib "user32" (ByVal nVirtKey As Long) As Integer
Declare Function timeGetTime Lib "winmm.dll" () As Long


Const LOGPIXELSX As Long = 88
Const LOGPIXELSY As Long = 90
Public Type POINTAPI


    x As Long
    y As Long
End Type


Function PPPixelX() As Double
Dim hDC As Long
hDC = GetDC(0)
PPPixelX = 72 / GetDeviceCaps(hDC, LOGPIXELSX)
ReleaseDC 0, hDC
End Function


Function PPPixelY() As Double
Dim hDC As Long
hDC = GetDC(0)
PPPixelY = 72 / GetDeviceCaps(hDC, LOGPIXELSY)
ReleaseDC 0, hDC
End Function


Function CorrectZoomFactor(ByVal z As Single) As Single
Select Case z
Case 2
z = 2
Case 1.75
z = 1.765
Case 1.5
z = 1.529
Case 1.25
z = 1.235
Case 1
z = 1
Case 0.9
z = 0.882
Case 0.85
z = 0.825
Case 0.8
z = 0.82
Case 0.75
z = 0.74
Case 0.7
z = 0.705
Case 0.65
z = 0.645
Case 0.6
z = 0.588
Case 0.55
z = 0.53
Case 0.5


z = 0.5296
Case Else
z = 1.0069 * z + 0.0055
End Select
CorrectZoomFactor = z
End Function


Function ВерхняяКоординатаМыши()
Dim cp As POINTAPI
Dim xpos_0 As Double, ypos_0 As Double
Dim z As Double

On Error Resume Next
GetCursorPos cp
With ActiveWindow
    z = CorrectZoomFactor(.Zoom / 100)
    xpos_0 = .PointsToScreenPixelsX(0)
    ypos_0 = .PointsToScreenPixelsY(0)
End With
Application.Cursor = xlNorthwestArrow
ВерхняяКоординатаМыши = (cp.y - ypos_0) / z * PPPixelY
'Application.Cursor = xlDefault
On Error GoTo 0
End Function

Не спрашивай меня, как этот код работает, я скачал его на одном из формуов. Единсвенное, что в общих чертах понял я: код определяет координату мыши на экране, потом определяет положение окна Эксель, потом уточняет значение с точки зрения масштаба в Эксель, потом уже выдает результат. Сложновато для меня пока.

В заключение

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

1. Стандартных Элементы управления Эксель ограниченное количество, ты же при желании можешь создавать собственные уникальные кнопки, меню, переключатели.
2. Дизайн абсолютно любой.
3. Реагирование можно варьировать.
4. Функция определения позиции мыши на экране позволяет делать сложные элементы управления в Экселе. Чек-боксы -- это только игрушка, в сравнении с тем, что можешь создать ты.
5. Можно легко создать процедуру копирования и изменения дизайна "на лету"

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