Lotiony's Blog

유저폼(Userform)은 엑셀 솔루션을 만들 때 많이 사용되는 요소입니다.

위의 방법을 다 적용하면 다음과 같이 타이틀바 없고, 모서리가 둥글고, 반투명한  유저폼도 생성할 수 있습니다. ^^

<타이틀바 없고, 모서리가 둥글고, 반투명한 유저폼>

하지만 너무 과도하게 효과를 넣으면 오히려 보기 싫어질 수가 있겠죠?

위에 간단하게 API 코드를 적었습니다만, 당연히 그냥은 실행이 안됩니다.

API 함수를 선언해 줘야 하고, 사용된 상수값들도 셋팅해 줘야겠죠.

1. Userform을 하나 생성하고, 버튼을 하나 만듭니다.(CommandButton1)

2. 아래 코드를 붙여넣습니다.

'//********** API용 상수값 설정
Private Const WS_CAPTION = &HC00000

Private Const LWA_COLORKEY = &H1        '## 색상지정값 확정
Private Const LWA_ALPHA = &H2           '## 투명도 확정
Private Const GWL_STYLE = (-16)         '## 윈도우 스타일
Private Const GWL_EXSTYLE = (-20)       '## 확장형윈도우 스타일
Private Const WS_EX_LAYERED = &H80000   '## 계층형 윈도우 생성

Private Const WM_NCMOUSEMOVE = &HA0
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const WM_NCLBUTTONUP = &HA2
Private Const WM_NCLBUTTONDBLCLK = &HA3
Private Const WM_NCRBUTTONDOWN = &HA4
Private Const WM_NCRBUTTONUP = &HA5
Private Const WM_NCRBUTTONDBLCLK = &HA6
Private Const WM_NCMBUTTONDOWN = &HA7
Private Const WM_NCMBUTTONUP = &HA8
Private Const WM_NCMBUTTONDBLCLK = &HA9
Private Const HTCAPTION = 2


Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub ReleaseCapture Lib "user32" ()

                                                       




Private Sub CommandButton1_Click()
    Unload Me
End Sub




Private Sub UserForm_Initialize()
    
    Dim hwnd As Long
    hwnd = FindWindow(IIf(Application.Version >= 11, "ThunderDFrame", "ThunderXFrame"), Me.Caption)
    
    '***** 캡션창을 없앤다.
    SetWindowLong hwnd, GWL_STYLE, GetWindowLong(hwnd, GWL_STYLE) And Not WS_CAPTION
    
    '***** 설정된 값으로 모서리가 둥근 유저폼 생성한다.
    SetWindowRgn hwnd, CreateRoundRectRgn(0, 0, Me.Width + 100, Me.Height, 20, 20), True
    
    '***** 반투명 레이어로 만들기 위해 유저폼 셋팅
    Call SetWindowLong(hwnd, GWL_EXSTYLE, GetWindowLong(hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED)
    
    '***** 반투명 폼으로 적용(0~255)
    Call SetLayeredWindowAttributes(hwnd, 0, 195, LWA_ALPHA)
    
    Me.Height = Me.Height + 1
    
End Sub




Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)

    Dim hwnd As Long

    '***** 마우스 왼쪽 버튼을 누은 상태에서 Drag한다면
    If Button = 1 And Shift = 0 Then

        '***** 유저폼의 핸들을 취득한다.
        hwnd = FindWindow(IIf(Application.Version >= 11, "ThunderDFrame", "ThunderXFrame"), Me.Caption)

        '***** 마우스 이벤트이외의 이벤트 발생을 허용
        Call ReleaseCapture
        
        '***** 해당 지점을 Caption Bar로 인식시킨다.
        Call SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)

    End If
    
End Sub




Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    '***** Alt+F4로도 종료하지 못하도록 조치함
    Cancel = CloseMode = 0
End Sub

이 포스팅에 소개한 예제 파일입니다.

이외에도 유저폼에 애니메이션 효과를 줄 수 있는 AnimateWindow 함수, 

포지션 및 크기를 Windows기준으로 설정할 수 있는 MoveWindow 함수, 

각 유저폼(또는 특정 핸들)을 다른 폼에 종속시킬 수 있는 SetParent 함수 등

필요에 따라 많은 API함수를 적용해 볼 수 있습니다.

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를 설계할 수 있지 않을까 생각됩니다.