VBA to change taskbar colour

T

tiredofit

Well-known Member
Joined
Apr 11, 2013
Messages
1,924
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
This thread shows how it's possible to change the theme using VBA:

Code: 
https://www.mrexcel.com/board/threads/change-office-theme-with-code.1260031/page-2#post-6190667

@Jaafar Tribak provided a nice solution.


I would like to know if it is possible to "extend" this idea.

Manually, the steps would be:

Code: 
Settings -> Personalisation -> Choose your mode -> Dark

and that changes the taskbar to black.

Is this possible to replicate using VBA?

Thanks
 
Sort by date Sort by votes
Jaafar Tribak said:
Try this to toggle the Taskbar AutoHide state:

VBA Code: 
Option Explicit

Private Type PAPPBARDATA
    cbSize As Long
    #If VBA7 Then
        hwnd As LongPtr
    #Else
        hwnd As Long
    #End If
    Bytes(0& To 23&) As Byte
    lParam As Long
End Type

#If VBA7 Then
    Private Declare PtrSafe Function SHAppBarMessage Lib "shell32.dll" (ByVal dwMessage As Long, pData As PAPPBARDATA) As LongPtr
    Private Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else
    Private Declare Function SHAppBarMessage Lib "shell32.dll" (ByVal dwMessage As Long, pData As PAPPBARDATA) As Long
    Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If

Sub ToggleTaskBarAutoHide()
    #If Win64 Then
        Const NULL_PTR = 0^
    #Else
        Const NULL_PTR = 0&
    #End If
    Const ABM_GETSTATE = &H4, ABM_SETSTATE = &HA
    Const ABS_ALWAYSONTOP = &H2, ABS_AUTOHIDE = &H1
    Dim uData As PAPPBARDATA   
    With uData
        .hwnd = FindWindow("Shell_TrayWnd", vbNullString)
        .cbSize = LenB(uData)
        If SHAppBarMessage(ABM_GETSTATE, uData) = NULL_PTR Then
            .lParam = ABS_AUTOHIDE
        Else
            .lParam = ABS_ALWAYSONTOP
        End If
        Call SHAppBarMessage(ABM_SETSTATE, uData)
    End With
End Sub
Click to expand...
Thanks, it worked in Windows 11.
 
Upvote 0

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
SHAppBarMessage is broadcasted to all top level windows causing them to refresh. I noticed that the VBE window gets activated and comes to the foreground even when it is closed. This is causes flickering and is very annoying.

To prevent this issue, we can temporarly remove the VBE window WS_CHILD style ... So the code now should become as follows :
VBA Code: 
Option Explicit

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
        Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
    #Else
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
        Private Declare PtrSafe Function GetWindowLong Lib "USER32.DLL" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    #End If
    Private Declare PtrSafe Function SHAppBarMessage Lib "shell32.dll" (ByVal dwMessage As Long, pData As PAPPBARDATA) As LongPtr
    Private Declare PtrSafe Function FindWindow Lib "USER32.DLL" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else
    Private Enum LongPtr
        [_]
    End Enum
    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 GetWindowLong Lib "USER32.DLL" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SHAppBarMessage Lib "shell32.dll" (ByVal dwMessage As Long, pData As PAPPBARDATA) As Long
    Private Declare Function FindWindow Lib "USER32.DLL" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If

Private Type PAPPBARDATA
    cbSize As Long
    hwnd As LongPtr
    Bytes(0& To 23&) As Byte
    lParam As Long
End Type

Sub ToggleTaskBarAutoHide()
    #If Win64 Then
        Const NULL_PTR = 0^
    #Else
        Const NULL_PTR = 0&
    #End If
    Const ABM_GETSTATE = &H4, ABM_SETSTATE = &HA
    Const ABS_ALWAYSONTOP = &H2, ABS_AUTOHIDE = &H1
    Dim uData As PAPPBARDATA
    MakeVBEChild(FindWindow("wndclass_desked_gsk", vbNullString)) = True
    With uData
        .hwnd = FindWindow("Shell_TrayWnd", vbNullString)
        .cbSize = LenB(uData)
        If SHAppBarMessage(ABM_GETSTATE, uData) = NULL_PTR Then
            .lParam = ABS_AUTOHIDE
        Else
            .lParam = ABS_ALWAYSONTOP
        End If
        Call SHAppBarMessage(ABM_SETSTATE, uData)
    End With
    MakeVBEChild(FindWindow("wndclass_desked_gsk", vbNullString)) = False
End Sub

Private Property Let MakeVBEChild(ByVal hwnd As LongPtr, ByVal vNewValue As Boolean)
    Const GWL_STYLE = (-16&), WS_CHILD = &H40000000
    Dim lNewStyle As Long
    If vNewValue Then
        lNewStyle = GetWindowLong(hwnd, GWL_STYLE) Or WS_CHILD
    Else
        lNewStyle = GetWindowLong(hwnd, GWL_STYLE) And Not WS_CHILD
    End If
    DoEvents
    Call SetWindowLong(hwnd, GWL_STYLE, lNewStyle)
End Property
 
Upvote 0
Jaafar Tribak said:
SHAppBarMessage is broadcasted to all top level windows causing them to refresh. I noticed that the VBE window gets activated and comes to the foreground even when it is closed. This is causes flickering and is very annoying.

To prevent this issue, we can temporarly remove the VBE window WS_CHILD style ... So the code now should become as follows :
VBA Code: 
Option Explicit

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
        Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
    #Else
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
        Private Declare PtrSafe Function GetWindowLong Lib "USER32.DLL" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    #End If
    Private Declare PtrSafe Function SHAppBarMessage Lib "shell32.dll" (ByVal dwMessage As Long, pData As PAPPBARDATA) As LongPtr
    Private Declare PtrSafe Function FindWindow Lib "USER32.DLL" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else
    Private Enum LongPtr
        [_]
    End Enum
    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 GetWindowLong Lib "USER32.DLL" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SHAppBarMessage Lib "shell32.dll" (ByVal dwMessage As Long, pData As PAPPBARDATA) As Long
    Private Declare Function FindWindow Lib "USER32.DLL" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If

Private Type PAPPBARDATA
    cbSize As Long
    hwnd As LongPtr
    Bytes(0& To 23&) As Byte
    lParam As Long
End Type

Sub ToggleTaskBarAutoHide()
    #If Win64 Then
        Const NULL_PTR = 0^
    #Else
        Const NULL_PTR = 0&
    #End If
    Const ABM_GETSTATE = &H4, ABM_SETSTATE = &HA
    Const ABS_ALWAYSONTOP = &H2, ABS_AUTOHIDE = &H1
    Dim uData As PAPPBARDATA
    MakeVBEChild(FindWindow("wndclass_desked_gsk", vbNullString)) = True
    With uData
        .hwnd = FindWindow("Shell_TrayWnd", vbNullString)
        .cbSize = LenB(uData)
        If SHAppBarMessage(ABM_GETSTATE, uData) = NULL_PTR Then
            .lParam = ABS_AUTOHIDE
        Else
            .lParam = ABS_ALWAYSONTOP
        End If
        Call SHAppBarMessage(ABM_SETSTATE, uData)
    End With
    MakeVBEChild(FindWindow("wndclass_desked_gsk", vbNullString)) = False
End Sub

Private Property Let MakeVBEChild(ByVal hwnd As LongPtr, ByVal vNewValue As Boolean)
    Const GWL_STYLE = (-16&), WS_CHILD = &H40000000
    Dim lNewStyle As Long
    If vNewValue Then
        lNewStyle = GetWindowLong(hwnd, GWL_STYLE) Or WS_CHILD
    Else
        lNewStyle = GetWindowLong(hwnd, GWL_STYLE) And Not WS_CHILD
    End If
    DoEvents
    Call SetWindowLong(hwnd, GWL_STYLE, lNewStyle)
End Property
Click to expand...
This doesn't compile for me.

Code: 
lNewStyle = GetWindowLong(hwnd, GWL_STYLE) Or WS_CHILD

Get a Type mismatch error.
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Solved
Change Office Theme with code
2
Replies
17
Views
706
tiredofit
T
H
  • Question Question
Launch userform on specific monitor
Replies
2
Views
121
HOGAN2023
H
F
  • Question Question
Making a UserForm behave as a Tool Window for another process
Replies
3
Views
297
fitzmorrispr
F
C
  • Solved
Insert a blanc row at a data change in column - office 365 dutch
2
Replies
11
Views
441
Joe4
Joe4
H
  • Question Question
Open Excel directly on the widest/largest screen
Replies
1
Views
575
HOGAN2023
H

Forum statistics

Threads
1,223,897
Messages
6,175,271
Members
452,628
Latest member
dd2

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top