« のんびり歩く | トップページ | BBQ »

2005/07/22

VBAによるサイズ変更可能なユーザーフォーム

たまにはマクロネタを書かないと、「なんだこの人、Excelと全然関係ないことしか書かないじゃない」と言われてしまうので、マクロに関係する内容を書きます。

基本的にVBAのユーザーフォームはマウスによる表示後のサイズ変更ができません。これはAPIを使えばすぐに実現できるのですが、ここではあえてVBAだけの機能を使ってサイズ変更が可能なユーザーフォームの作成方法について解説してみます。

まず、図のように3つのイメージコントロールを配置し、名前を変更します。
場所は適当に配しておけば、VBAで位置を設定するのでこのままでOKです。

UserFormResizable

次に以下のコードを作成します。以上ですが、サンプルファイルを作成しましたので、ダウンロードして動作の確認をしてみて下さい。


Option Explicit
Option Base 1

'定数
Private Const MODE_RESIZE_X = 0
Private Const MODE_RESIZE_Y = 1
Private Const MODE_RESIZE_XY = 2

'変数
Private flgResize As Boolean
Private ResizeX As Single
Private ResizeY As Single

'*** リサイズ用コントロールの再配置 ***
Private Sub SetResizeControls()
   
    With imgResizeXY
       
        .Left = Me.InsideWidth - .Width
        .Top = Me.InsideHeight - .Height
        .ZOrder 0
       
    End With
   
    With imgResizeY
       
        .Left = 0
        .Top = imgResizeXY.Top
        .Width = imgResizeXY.Left
        .ZOrder 0
       
    End With
   
    With imgResizeX
   
        .Top = 0
        .Left = imgResizeXY.Left
        .Height = imgResizeXY.Top
        .ZOrder 0
       
    End With
   
End Sub

'*** リサイズ用コントロール上でマウスをクリック ****
Private Sub Resize_MouseDown(X As Single, Y As Single, Button As Integer)
    If Button = 1 Then
        flgResize = True
        ResizeX = X
        ResizeY = Y
    End If
End Sub

'*** リサイズ用コントロール上でマウスをドラッグ ***
Private Sub Resize_MouseMove(X As Single, Y As Single, Mode As Byte)
   
    If flgResize Then
       
        If Mode = MODE_RESIZE_X Or Mode = MODE_RESIZE_XY Then
            Me.Width = Me.Width + X - ResizeX
            ResizeX = X
        End If
       
        If Mode = MODE_RESIZE_Y Or Mode = MODE_RESIZE_XY Then
            Me.Height = Me.Height + Y - ResizeY
            ResizeY = Y
        End If
       
    End If
   
End Sub

'*** リサイズ用コントロール上でマウスを離す ***
Private Sub Resize_MouseUp(Button As Integer)
   
    If Button = 1 Then
        flgResize = False
        Call SetResizeControls
    End If
   
End Sub

'*** 縦のリサイズ ***
Private Sub imgResizeY_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call Resize_MouseDown(X, Y, Button)
End Sub

Private Sub imgResizeY_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call Resize_MouseMove(X, Y, MODE_RESIZE_Y)
End Sub

Private Sub imgResizeY_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call Resize_MouseUp(Button)
End Sub

'*** 横のリサイズ ***
Private Sub imgResizeX_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call Resize_MouseDown(X, Y, Button)
End Sub

Private Sub imgResizeX_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call Resize_MouseMove(X, Y, MODE_RESIZE_X)
End Sub

Private Sub imgResizeX_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call Resize_MouseUp(Button)
End Sub

'*** 縦横のリサイズ ***
Private Sub imgResizeXY_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call Resize_MouseDown(X, Y, Button)
End Sub

Private Sub imgResizeXY_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call Resize_MouseMove(X, Y, MODE_RESIZE_XY)
End Sub

Private Sub imgResizeXY_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call Resize_MouseUp(Button)
End Sub

'*** フォームの初期化 ***
Private Sub UserForm_Initialize()
   
    '*** 枠線の消去 ***
    imgResizeX.BorderStyle = fmBorderStyleNone
    imgResizeY.BorderStyle = fmBorderStyleNone
    imgResizeXY.BorderStyle = fmBorderStyleNone
   
    '*** マウスポインターの設定 ***
    imgResizeX.MousePointer = fmMousePointerSizeWE
    imgResizeY.MousePointer = fmMousePointerSizeNS
    imgResizeXY.MousePointer = fmMousePointerSizeNWSE
   
    Call SetResizeControls
   
End Sub

|

« のんびり歩く | トップページ | BBQ »

コメント

コメントを書く



(ウェブ上には掲載しません)




トラックバック

この記事のトラックバックURL:
http://app.cocolog-nifty.com/t/trackback/79953/5085966

この記事へのトラックバック一覧です: VBAによるサイズ変更可能なユーザーフォーム:

« のんびり歩く | トップページ | BBQ »