Introduction | Example | Tutorial | Applications

Introduction - Transparent UserForm

If you’ve been searching for a way to make a VBA UserForm with a transparent background, you’ve finally come to the right place. In this tutorial, I’ll show you how to make the background of your UserForm transparent and I’ll illustrate how you can use these macros to make the BackColor or ForeColor of your controls transparent, too.

That’s right. It will look like the controls on your UserForm are sitting right on top of the Excel grids!

If you want to slowly fade your userform in and out instead, check out my tutorial on fading your VBA userform.


Example - Transparent UserForm

'PLACE IN YOUR USERFORM CODE
Option Explicit
Private Declare Function FindWindow Lib "user32" _
    Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
                       
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 DrawMenuBar Lib "user32" ( _
    ByVal hWnd As Long) 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
 
'Constants for title bar
Private Const GWL_STYLE As Long = (-16)           'The offset of a window's style
Private Const GWL_EXSTYLE As Long = (-20)         'The offset of a window's extended style
Private Const WS_CAPTION As Long = &HC00000       'Style to add a titlebar
Private Const WS_EX_DLGMODALFRAME As Long = &H1   'Controls if the window has an icon
 
'Constants for transparency
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1                  'Chroma key for fading a certain color on your Form
Private Const LWA_ALPHA = &H2                     'Only needed if you want to fade the entire userform
 
Private Sub UserForm_Activate()
HideTitleBarAndBorder Me 'hide the titlebar and border
MakeUserFormTransparent Me 'make certain color transparent
End Sub
 
Sub MakeUserFormTransparent(frm As Object, Optional Color As Variant)
'set transparencies on userform
Dim formhandle As Long
Dim bytOpacity As Byte
 
formhandle = FindWindow(vbNullString, Me.Caption)
If IsMissing(Color) Then Color = vbWhite 'default to vbwhite
bytOpacity = 100 ' variable keeping opacity setting
 
SetWindowLong formhandle, GWL_EXSTYLE, GetWindowLong(formhandle, GWL_EXSTYLE) Or WS_EX_LAYERED
'The following line makes only a certain color transparent so the
' background of the form and any object whose BackColor you've set to match
' vbColor (default vbWhite) will be transparent.
    Me.BackColor = Color
    SetLayeredWindowAttributes formhandle, Color, bytOpacity, LWA_COLORKEY
End Sub
 
Sub HideTitleBarAndBorder(frm As Object)
'Hide title bar and border around userform
    Dim lngWindow As Long
    Dim lFrmHdl As Long
    lFrmHdl = FindWindow(vbNullString, frm.Caption)
'Build window and set window until you remove the caption, title bar and frame around the window
    lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE)
    lngWindow = lngWindow And (Not WS_CAPTION)
    SetWindowLong lFrmHdl, GWL_STYLE, lngWindow
    lngWindow = GetWindowLong(lFrmHdl, GWL_EXSTYLE)
    lngWindow = lngWindow And Not WS_EX_DLGMODALFRAME
    SetWindowLong lFrmHdl, GWL_EXSTYLE, lngWindow       
    DrawMenuBar lFrmHdl
End Sub

Make powerful macros with our free VBA Developer Kit

Tutorials like this can be complicated. That’s why we created our free VBA Developer Kit and our Big Book of Excel VBA Macros to supplement this tutorial. Grab them below and you’ll be writing powerful macros in no time.

I'll take a free VBA Developer Kit

If you’re in a hurry, copy and paste the example macros above into the Code portion of your UserForm and be on your way. If you’d like a step-by-step tutorial of how to incorporate the codes above into your UserForm, scroll down to the Tutorial section.


Tutorial - Transparent UserForm

Step 1: Create your UserForm

If you made it this far, you probably already have a UserForm designed. If not, go ahead and do it now.

Since today is the 4th of July, here’s what my UserForm looks like:

Transparent UserForm Design

It’s a very simple UserForm. All I have in mine is a picture and a little birthday message for the United States of America.

ShowModal UserForms

If you want your user to be able to click around your spreadsheet while your transparent UserForm is displayed, you’ll need to set the ShowModal property of your UserForm to false.

This is really cool because people will be able to click cells right behind where your UserForm should be. They’ll even be able to click through the holes in your label text!


Step 2: Set your Transparent Colors

I set up the macros so, by default, any object normally shown as white will be transparent, or clear, when the UserForm is shown. This excludes the background of the UserForm which will ALWAYS show up transparent the way I built the macros and it excludes any white that appears inside of pictures.

In my example, I want the color behind the text label to show up clear. I want it to look like the text is written right on top of the Excel cells.

To make that happen, I’ll select the label in the UserForm and set the BackColor property of the label to white, like this:

Transparent UserForm Label

You can set the ForeColor to white and the BackColor to a different color if you want the letters themselves to look invisible.

Note: There’s a way you can change the color you want to be transparent. I’ll explain how in Step 3. This is important if you don’t want your textboxes and listboxes to automatically look clear

Once you’ve set all the controls you want to be transparent by changing their color to white, continue to Step 3.


Step 3: Add the Macros

Right-click your UserForm and select “View Code.” Copy and paste the example macro into the UserForm code block.

The most challenging part of this macro was removing the little border that appears around your UserForm. You don’t even notice it’s there, but once you make the background transparent, you’re left with a border showing the outline of your UserForm. It was very ugly!

One thing to notice is that the macro I provided will not work on a 64-bit version of Excel until you add the PtrSafe keyword after the “Declare” and before the “Function” in all the user32 declarations at the top of the macro.

Change Color You Want to be Transparent

If you already set the color of each item you want to become transparent to white, you’re all set.

If you set it to a different a color, you’ll want to find the UserForm_Activate procedure and add the color you want to become transparent as a second argument in the call statement to MakeUserFormTransparent. For example,

MakeUserFormTransparent Me, vbBlue

The long number representing the RGB code of your transparent color can also be passed, like this:

MakeUserFormTransparent Me, RGB(0, 0, 255)


Step 4: Launch UserForm

Here’s where you get to see all your hard work pay off. Launch your UserForm! You can launch it by pressing F5 or hitting the play button in your Visual Basic Editor.

If you made a UserForm like mine, you’ll have to click the text or the flag and hit Alt-F4 to exit the form since I didn’t include an unload me button.

Here’s what mine looks like when it’s launched:

Transparent UserForm

Remember earlier how I said if you set your ShowModal property to false, you can click right through the transparent portions of your UserForm? Here’s proof that I wasn’t just making that up!

Transparent UserForm Animation

I clicked right through the triangle in “4” and selected the cell beneath it. If you click directly on the red text, it selects the UserForm instead.

Application Ideas

I don’t know how you feel, but I’m feeling pretty excited about this project! VBA is known for having such. boring. user-interfaces. The ability to make transparent backgrounds on your userforms like this lets you add just a little bit of flair to the otherwise boring world of userforms.

Try to combine this with your custom Excel Splash Screens and share your results with me in the comments section!


Comments

Happy 4th of July, everybody! I hope you all have a wonderful Independence Day!

This tutorial was a fun one to put together. I sincerely hope you’ll share the forms you create with me in the comments section.

When you’re ready to take your VBA to the next level, subscribe using the form below.