[VBA] Cacher barre des tâches pour appli plein écran

‘******************************

‘**** Auteur : Lermite ****

‘** Date 2 décembre 2012 **

‘******************************

Cette démo est surtout utile quand l’écran n’est pas de grande dimension, elle permet l’affichage de l’appli sur toute la surface de l’écran en « cachant » la barre des tâches.

Si votre application n’est utilisée que sur votre PC et que votre barre des tâches est paramétrée pour être « rétractible », cette démo ne vous est pas nécessaire.

Cette démo est agencée en « bascule » de telle façon qu’un seul bouton ou raccourci clavier est nécessaire pour fonctionner.

Le code dans un module général

'*************************
'***    LERMITE   ********
'***  06/03/2010  ********
'*************************
Option Explicit
Public Bascule As Boolean

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
Public Declare Function SHAppBarMessage Lib "shell32.dll" (ByVal dwMessage As Long, pData As AppBarData) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As _
    Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Type POINTAPI
        X As Long
        Y As Long
End Type
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Public Type AppBarData
        cbSize As Long
        hwnd As Long
        uCallbackMessage As Long
        uEdge As Long
        rc As RECT
        lParam As Long
End Type
Private Type WINDOWPLACEMENT
        Length As Long
        FLAGS As Long
        showCmd As Long
        ptMinPosition As POINTAPI
        ptMaxPosition As POINTAPI
        rcNormalPosition As RECT
End Type
Public WinPlacement As WINDOWPLACEMENT

Public Const ABS_ALWAYSONTOP = &H2
Public Const ABS_AUTOHIDE = &H1
Public Const ABM_GETSTATE = &H4
Public Const ABM_SETSTATE = &HA

' Trouver le hwnd de la barre des tâches
Private Function GetHwndBT() As Long
    GetHwndBT = FindWindow("shell_traywnd", "")
End Function

Private Function BarData() As Integer
    Dim BarDt As AppBarData
    BarData = SHAppBarMessage(ABM_GETSTATE, BarDt)
End Function

'Retourne true si la barre des tâches est rétractible
Public Function BarMode() As Boolean
Dim ret As Integer
    ret = BarData()
    BarMode = (ret = ABS_AUTOHIDE + ABS_ALWAYSONTOP Or ret = ABS_AUTOHIDE)
End Function

'Applique les propriétés à la barre des taches
'Mode = 0 : voir la barre des tâche
'Mode = 1 : cache la barre des tâches
Public Sub ChangeTaskBar(Mode As Long)
Dim BarDt As AppBarData
Dim ret As Long

    'Entrée des paramètres
    BarDt.cbSize = Len(BarDt)
    BarDt.hwnd = GetHwndBT
    BarDt.lParam = Mode
    'Applique
    ret = SHAppBarMessage(ABM_SETSTATE, BarDt)

If ret = 0 Then
    Call MsgBox("erreur lors de l'appel de SHAppBarMessage", vbCritical + vbOKOnly, "Erreur")
End If
End Sub

Sub MaximizeAppli()
Static a As Boolean
Static Changer As Integer
    If Changer = 0 Then
        'Voir si la barre des tâches est rétractible
        Changer = IIf(BarMode, 1, 2)
    End If
    a = Not a
    If Changer = 2 Then
        'la barre des tâches n'est pas rétractible, ont la retracte / Ressort
        Call ChangeTaskBar(Abs(a))
    End If
    'L'appli sera toujours maximizée plein écran.
    Application.WindowState = IIf(a, xlMaximized, xlNormal)
End Sub

Trois exemples pour employer la fonction.

1) Un raccourci clavier.

Dans le ruban, cliquez sur Macro, sélectionnez la macro MaximizeAppli

->> option et attribuez une lettre au raccourci.

2°) Un bouton formulaire sur un forme

Attribuer la fonction MaximizeAppli au bouton

3°) Avec un bouton sur un Userform

Attention, l'userForm doit être appeler avec Show 0

Dans le code du bouton de l'UserForm

Private Sub CommandButton1_Click()
    MaximizeAppli
Dim T, L
    'Positionne le bouton aux environs des boutons système de l'appli.
    L = Application.Left + Application.Width - UFbouton.Width - 60
    T = Application.Top + 2
    Me.Move L, T, 40, 14 ' à adapter
End Sub

Vous pouvez télécharger une classeur démo qui reprend les trois solutions d'appel.

Note : les fonctions OterCadreUF et transparence appliquées à L'UserFom ne sont là que pour la démo et ne sont pas indispensables.

Télécharger le classeur démo :