トップ > 逆引きで学ぶ ユーザーフォーム&コントロール > 追加章　遊ぶ！楽しむ！ユーザーフォーム > T-04　フォーム上のイメージの移動を指定範囲内に制限する

'フォーム上にセルに見立てたラベルを格子状に配置しています
'そのラベル群を便宜上フォームセルと呼びます
Option Explicit

'定数
Private Const FCW As Single = 18        'フォーム上のセル幅
Private Const FCH As Single = 18        'フォーム上のセル高さ
Private Const FCN As String = "FCells_" 'フォーム上のセルのベース名

'変数
Private strImageName As String          'キャッチしているイメージ名
Private strAddress   As String          'キャッチしているイメージのTopLeftセルアドレス

'■ラベルイベント(Label_Main)
'+++ MouseDownイベント +++
Private Sub Label_Main_MouseDown(ByVal Button As Integer, _
                                 ByVal Shift As Integer, _
                                 ByVal X As Single, _
                                 ByVal Y As Single)
    With Label_Main
        If strImageName = "" Then
            strImageName = Get_ImageName(.Left, .Top, X, Y)
        Else
            Dim varSplit As Variant
            varSplit = Split(strAddress, ",")
            
            'フォームセルの行列を元に位置設定
            Controls(strImageName).Left = .Left + (Val(varSplit(1)) - 1) * FCW
            Controls(strImageName).Top = .Top + (Val(varSplit(0)) - 1) * FCH
            
            strImageName = ""
        End If
    End With
End Sub

'+++ MouseMoveイベント +++
Private Sub Label_Main_MouseMove(ByVal Button As Integer, _
                                 ByVal Shift As Integer, _
                                 ByVal X As Single, _
                                 ByVal Y As Single)
    'イメージ名が空白の場合は抜ける
    If strImageName = "" Then Exit Sub
    
    Dim sinLeft As Single
    Dim sinTop  As Single
    Dim lngR    As Long
    Dim lngC    As Long
    With Label_Main
        'イメージの中心がマウスポインタ位置になるように調整
        sinLeft = .Left + X - (Controls(strImageName).Width / 2)
        sinTop = .Top + Y - (Controls(strImageName).Height / 2)
        
        'Label_Main内範囲制限
        If sinLeft < .Left Then sinLeft = .Left
        If .Left + .Width - Controls(strImageName).Width < sinLeft Then
            sinLeft = .Left + .Width - Controls(strImageName).Width
        End If
        If sinTop < .Top Then sinTop = .Top
        If .Top + .Height - Controls(strImageName).Height < sinTop Then
            sinTop = .Top + .Height - Controls(strImageName).Height
        End If
        
        '位置設定
        Controls(strImageName).Left = sinLeft
        Controls(strImageName).Top = sinTop
        
        'イメージ左上隅のフォームセル行列取得
        lngC = (FCW / 2 + sinLeft) \ FCW
        lngR = (FCH / 2 + sinTop) \ FCH
        strAddress = lngR & "," & lngC
    End With
End Sub

'■関数
'+++ イメージ名取得関数 +++++++++++++++++++++++++++++++++++++++++
'マウスポインタがイメージと重なっている場合にそのイメージ名を返す
'【引数】
'   L：イベント感知ラベルLeft位置
'   T：イベント感知ラベルTop位置
'   X：マウスポインタX位置
'   Y：マウスポインタY位置
'【戻り値】
'   イメージ名
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Private Function Get_ImageName(ByVal L As Single, ByVal T As Single, _
                               ByVal X As Single, ByVal Y As Single) As String
    Dim objC As MSForms.Control
    For Each objC In Me.Controls
        If TypeName(objC) = "Image" Then 'コントロールタイプ判定
            With objC
                '重なり判定
                If .Left < (L + X) And (L + X) < (.Left + .Width) Then
                    If .Top < (T + Y) And (T + Y) < (.Top + .Height) Then
                        Get_ImageName = .Name
                        Exit Function
                    End If
                End If
            End With
        End If
    Next
End Function

書籍紹介140以上のサンプルファイル付き！

知りたいがすぐわかる！　やりたいがすぐできる！
「Excel VBA 逆引きで学ぶ ユーザーフォーム&コントロール」（Kindle版）
ユーザーフォームを扱えると、VBAでできることが大きく広がります！
本書では、知りたいこと、やりたいことから、逆引きで学びを深められます。

■ 購入：amazon