Introduction | Example | Tutorial | Applications

Introduction - Borderless UserForm

This tutorial shows you how to hide the border on your UserForm using VBA. A UserForm without a title bar and X button are far cleaner than normal UserForms. Creating a UserForm like this is great for splash screens and catchy interfaces.

Keep reading this VBA tutorial to learn how you can make prettier UserForms by removing the ugly title bar at the top and border around the edges.


Example - Borderless UserForm

'PLACE IN A STANDARD MODULE
Option Explicit
Option Private Module

Public Const GWL_STYLE = -16
Public Const WS_CAPTION = &HC00000
#If VBA7 Then
    Public Declare PtrSafe Function GetWindowLong _
                           Lib "user32" Alias "GetWindowLongA" ( _
                           ByVal hwnd As LongPtr, _
                           ByVal nIndex As Long) As Long
    Public Declare PtrSafe Function SetWindowLong _
                           Lib "user32" Alias "SetWindowLongA" ( _
                           ByVal hwnd As LongPtr, _
                           ByVal nIndex As Long, _
                           ByVal dwNewLong As Long) As Long
    Public Declare PtrSafe Function DrawMenuBar _
                           Lib "user32" ( _
                           ByVal hwnd As LongPtr) As Long
    Public Declare PtrSafe Function FindWindowA _
                           Lib "user32" (ByVal lpClassName As String, _
                           ByVal lpWindowName As String) As LongPtr
#Else
    Public Declare Function GetWindowLong _
                           Lib "user32" Alias "GetWindowLongA" ( _
                           ByVal hWnd As Long, _
                           ByVal nIndex As Long) As Long
    Public Declare Function SetWindowLong _
                           Lib "user32" Alias "SetWindowLongA" ( _
                           ByVal hWnd As Long, _
                           ByVal nIndex As Long, _
                           ByVal dwNewLong As Long) As Long
    Public Declare Function DrawMenuBar _
                           Lib "user32" ( _
                           ByVal hWnd As Long) As Long
    Public Declare Function FindWindowA _
                           Lib "user32" (ByVal lpClassName As String, _
                           ByVal lpWindowName As String) As Long
#End If
Sub HideTitleBar(frm As Object)
#If VBA7 Then
    Dim lFrmHdl As LongPtr
#Else
    Dim lFrmHdl As Long
#End If
    Dim lngWindow As Long
    lFrmHdl = FindWindowA(vbNullString, frm.Caption)
    lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE)
    lngWindow = lngWindow And (Not WS_CAPTION)
    Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow)
    Call DrawMenuBar(lFrmHdl)
End Sub

Make powerful macros with our free VBA Developer Kit

It’s easy to copy and paste a macro like this, but it’s harder make one on your own. To help you make macros like this, we built a free VBA Developer Kit and wrote the Big Book of Excel VBA Macros full of hundreds of pre-built macros to help you master file I/O, arrays, strings and more - grab your free copy below.

I'll take a free VBA Developer Kit

Tutorial - Borderless UserForm

Hiding Your Title Bar

In this tutorial, I’m going to assume you already have your UserForm designed. Once you’ve copied and pasted the example macro into a regular module, all you have to do is go to the code for your UserForm and paste the following macro:

'PLACE IN YOUR USERFORM
Private Sub UserForm_Initialize()
    HideTitleBar Me
End Sub

Reminder: To access the code for your UserForm, right click your UserForm in the Project Explorer Pane and click “View Code.”

This feature will work with both 32-bit and 64-bit versions of Excel. Each time your UserForm is started, it invokes the UserForm_Initialize subroutine and hides the title bar. Your left with a beautiful borderless UserForm like the one below:

Borderless UserForm - VBA Remove Title Bar

If you’re wondering where this UserForm came from, it’s from my PDF VBA Excel Add-in - a really cool add-in for converting your Excel creations to sleek PDFs.

One thing you may notice when you launch your UserForm is that all the elements of your UserForm are shifted up higher than they appear when you’re viewing your UserForm in design mode. That’s because each element is shifted up by the original height of the title bar.

To compensate for this, all you have to do is shorten the height of your UserForm.

Showing Your Title Bar

To show the border and title again after removing it, you would add the following macro to your standard module and call it from your UserForm object (button, toggle, checkbox, etc.):

'PLACE IN SAME STANDARD MODULE
Sub ShowTitleBar(frm As Object)
#If VBA7 Then
    Dim lFrmHdl As LongPtr
#Else
    Dim lFrmHdl As Long
#End If
    Dim lngWindow As Long
    lFrmHdl = FindWindowA(vbNullString, frm.Caption)
    lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE)
    lngWindow = lngWindow + (WS_CAPTION)
    Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow)
    Call DrawMenuBar(lFrmHdl)
End Sub

For example, if you had a command button on your UserForm named CommandButtonShow, you would call the ShowTitleBar routine from your UserForm by adding the following code to the UserForm:

'PLACE IN YOUR USERFORM
Private Sub CommandButtonShow_Click()
    ShowTitleBar Me
End Sub

Application Ideas - Borderless UserForm

As I said in my introduction, creating a UserForm without borders is perfect for splash screens, but it’s also great for an “About Me” page and other interactive designs, like calendars.

What beautiful borderless UserForms can you create?

Occassionally I’m asked how people can help keep the VBA Tutorials Blog online. The best thing you can do is purchase the add-ins on my Excel Add-ins page. This is my primary source of blog revenue and the money I receive from sales helps pay to keep this website online and accessible for all to learn.

Share this article with the world on Twitter and Facebook!

Now’s the time I kindly remind you to subscribe to my free wellsrPRO VBA Training Program using the form below. Once you subscribe, you’ll get access to a free copy of my Excel Add-In with tons of useful features and you’ll get monthly tutorials where I show you how to do some pretty cool stuff with VBA:)