Search code examples
vbawinapiexceltitlebar

Can you change the color of the titlebar of a userform in VBA using Windows API?


Is it possible to change the color of the title bar for a VBA userform using Windows API. Please note that I am only interested in changing the color of the title bar for a particular userform and not a system-wide them change. Thanks!


Solution

  • Just for fun;

    enter image description here

    UserForm:

    Private gHWND As Long
    
    Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        If Button = 1 Then HandleDragMove gHWND
    End Sub
    
    Private Sub UserForm_Initialize()
        gHWND = Setup(Me)
    End Sub
    
    Private Sub UserForm_Click()
        Unload Me
    End Sub
    

    *.BAS

    Option Explicit
    Private Const WM_NCLBUTTONDOWN = &HA1&
    Private Const HTCAPTION = 2&
    Private Const GWL_STYLE = (-16)
    Private Const WS_BORDER = &H800000
    Private Const WS_DLGFRAME = &H400000
    Private Const WS_CAPTION = WS_BORDER Or WS_DLGFRAME
    Private Declare Sub ReleaseCapture Lib "User32" ()
    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 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
    
    Function Setup(objForm As Object) As Long
        Setup = FindWindow("ThunderDFrame", objForm.Caption)
        SetWindowLong Setup, GWL_STYLE, GetWindowLong(Setup, GWL_STYLE) And Not WS_CAPTION
    End Function
    
    Public Sub HandleDragMove(HWND As Long)
        Call ReleaseCapture
        Call SendMessage(HWND, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
    End Sub
    

    (Would need mod for 64bit Office)