VBA에서 사용되는 Userform은 기본적으로 사이즈조절(Resizable)이 되지 않습니다.
이 설정을 변경하는 옵션 또한 지원되지 않습니다.
하지만 기본적으로 Userform은 Windows Form 2.0 을 사용하는 일반 윈도우폼입니다.
그동안은 사용할 없었는데, 요번에 사용자에 의해서 크기가 조절되어야 하는 유저폼이 필요한 일이 생겨 찾게 되었습니다.
방법은 그다지 어렵지 않더군요..
1. 빈 유저폼을 만듭니다.
2. 프로젝트 탐색기에서 우클릭 한 후 [삽입] – [클래스 모듈] 을 선택해 클래스모듈을 하나 만들어 줍니다.
3. 속성에서 방금 생성된 클래스모듈의 이름을 CResizer 로 변경합니다.
(속성창이 안 보이면 F4)
4. CResizer 클래스모듈에 아래의 코드를 복사해 붙여 넣습니다.
Option Explicit
Private Const MFrameResizer = "FrameResizeGrab"
Private Const MResizer = "ResizeGrab"
Private WithEvents m_objResizer As MSForms.Frame
Private m_sngLeftResizePos As Single
Private m_sngTopResizePos As Single
Private m_blnResizing As Single
Private WithEvents m_frmParent As MSForms.UserForm
Private m_objParent As Object
Private Sub Class_Terminate()
m_objParent.Controls.Remove MResizer
End Sub
Private Sub m_frmParent_Layout()
If Not m_blnResizing Then
With m_objResizer
.Top = m_objParent.InsideHeight - .Height
.Left = m_objParent.InsideWidth - .Width
End With
End If
End Sub
Private Sub m_objResizer_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
If Button = 1 Then
m_sngLeftResizePos = x
m_sngTopResizePos = y
m_blnResizing = True
End If
End Sub
Private Sub m_objResizer_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
If Button = 1 Then
With m_objResizer
.Move .Left + x - m_sngLeftResizePos, .Top + y - m_sngTopResizePos
m_objParent.Width = m_objParent.Width + x - m_sngLeftResizePos
m_objParent.Height = m_objParent.Height + y - m_sngTopResizePos
.Left = m_objParent.InsideWidth - .Width
.Top = m_objParent.InsideHeight - .Height
End With
End If
End Sub
Private Sub m_objResizer_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
If Button = 1 Then
m_blnResizing = False
End If
End Sub
Public Function Add(Parent As Object) As MSForms.Frame
'
' add resizing control to bottom righthand corner of userform
'
Dim labTemp As MSForms.Label
Set m_frmParent = Parent
Set m_objParent = Parent
Set m_objResizer = m_objParent.Controls.Add("Forms.Frame.1", MFrameResizer, True)
Set labTemp = m_objResizer.Add("Forms.label.1", MResizer, True)
With labTemp
With .Font
.Name = "Marlett"
.Charset = 2
.Size = 14
.Bold = True
End With
.BackStyle = fmBackStyleTransparent
.AutoSize = True
.BorderStyle = fmBorderStyleNone
.Caption = "o"
.MousePointer = fmMousePointerSizeNWSE
.ForeColor = RGB(100, 100, 100)
.ZOrder
.Top = 1
.Left = 1
.Enabled = False
End With
With m_objResizer
.MousePointer = fmMousePointerSizeNWSE
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.ZOrder
.Caption = ""
.Width = labTemp.Width + 1
.Height = labTemp.Height + 1
.Top = m_objParent.InsideHeight - .Height
.Left = m_objParent.InsideWidth - .Width
End With
End Function
5. 만들어 두었던 유저폼(Userform1) 에 아래의 코드를 붙여 넣습니다.
Private m_clsResizer As CResizer
Private Sub UserForm_Initialize()
Set m_clsResizer = New CResizer
m_clsResizer.Add Me
End Sub
Private Sub UserForm_Terminate()
Set m_clsResizer = Nothing
End Sub
6. Userform1.show 로 유저폼을 띄워보면 우측하단에 Resize 조절이 가능한 표시가 보이게 됩니다.
이렇게 크기 조절이 가능한 유저폼(Resizable Userform)을 만들었습니다.
물론 이렇게까지만 해놓고 쓸일은 없겠죠. 크기조절을 시킬 때 무언가를 해 주어야 합니다.
그냥 크기만 늘었다 줄었다 하면 아무 소용이 없죠…
폼 안에 있는 컨트롤을 동적으로 움직여줘야 할 수도 있고, 여튼 폼 크기 조절을 사용자에게 시키려던 목적이 있을겁니다.
그리고 그 액션에 대응하는 코드도 작성을 해 주어야 합니다.
이 코드는 Userform1_Resize() 이벤트 프로시저 안에 작성해 주면 됩니다.
1. Userform1에 빈 레이블(Label)을 아무곳에나 하나 추가합니다.
그리고 유저폼 초기화 프로시저를 아래처럼 수정합니다.
Private Sub UserForm_Initialize()
Set m_clsResizer = New CResizer
m_clsResizer.Add Me
With Label1
.Visible = False
.Top = Me.Height - .Height - 30
.Left = Me.Width - .Width - 20
End With
End Sub
2. Userform 코드에 아래와 같이 Resize 이벤트 프로시저를 추가해 줍니다.
Private Sub UserForm_Resize()
With Label1
.Caption = "W : " & Me.Width & " H : " & Me.Height
.Top = Me.Height - .Height - 30
.Left = Me.Width - .Width - 20
End With
End Sub
3. CResizer 클래스 모듈에서 MouseDown과 MouseUp 프로시저를 찾아 아래처럼 수정해 줍니다. 이건 기능보다는 약간의 재미를 위해서입니다.
Private Sub m_objResizer_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
If Button = 1 Then
m_sngLeftResizePos = x
m_sngTopResizePos = y
m_blnResizing = True
'***** Label Visible
m_objParent.Label1.Visible = True
End If
End Sub
Private Sub m_objResizer_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
If Button = 1 Then
m_blnResizing = False
'***** Label Invisible
m_objParent.Label1.Visible = False
End If
End Sub
4. 유저폼을 실행한 후 크기조절을 해 보면 아래처럼 현재 창의 크기가 레이블에 표시되고, 창의 크기와 관계없이 우측 하단 고정된 위치에 따라붙게 됩니다.
그다지 많이 쓰일일은 없지만, 활용 여하에 따라 보다 나은 Activity한 UX를 설계할 수 있지 않을까 생각됩니다.
'Excel Develop > VBA' 카테고리의 다른 글
| [ACCESS] 엑세스의 일련번호(Autonumber Counter) 를 초기화하는 쿼리 (0) | 2013.07.04 |
|---|---|
| [VB/VBA] 자동으로 닫히는 MsgBox (4) | 2012.11.27 |
| [VBA] API로 유저폼(Userform) 주무르기 - 타이틀바(캡션) 없애기, 모서리 둥글게 만들기, 투명한 유저폼 만들기 (3) | 2012.11.24 |
| [vba] Twain드라이버와 Lead Tools를 이용해 스캐너 직접 제어 (5) | 2012.01.20 |
Resizable Userform.xlsm