Microsoft 365 icone Excel remplacée

Declareptrsafe
FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

#If VBA7 Then
    Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
        ByVal lpClassName As String, _
        ByVal lpWindowName As String) As LongPtr
#Else
    Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
        ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long
#End If

Option Explicit

Private Sub Workbook_Activate()
    XlMainIconSwitch (Feuil1.Image1.Picture.Handle)
End Sub

Private Sub Workbook_Open()
    Dim TexteCaption As String
    TexteCaption = "Bonjour ;)) " & Application.UserName
    XlMainIconSwitch (Feuil1.Image1.Picture.Handle)
    Application.Caption = TexteCaption
End Sub

'*****************************************************************************************************
'    ___     _     _______  __      _   ____  _   _  _______  ___     _   _   _    ___     _     _.
'   //  \\  /\\      //    // \\   //  //    //  //    //    //  \\  //  //  //   //  \\  //|   //
'  //___// //__\    //    //__//  //  //    //__//    //    //   // //  //  //   //   // // |  //
' //      //   \\  //    //  \\  //  //    //  \\    //    //   // //  //  //   //   // //  | //
'//      //    // //    //   // //  //___ //    \\  //     \\__// //__//  //___ \\__// //   |//
'****************************************************************************************************
'fonction  pour changer l'icon de excel
'patricktoulon
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As LongPtr) As Long
#Else
    Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
    Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
#End If
Const WM_SETICON As Long = &H80
Const ICON_SMALL As Long = 0
Const ICON_BIG As Long = 1

#If VBA7 Then
Sub XlMainIconSwitch(Optional ByVal hIcon As LongPtr = 0&)
    Dim hWnd As LongPtr
#Else
Sub XlMainIconSwitch(Optional ByVal hIcon As Long = 0&)
    Dim hWnd As Long
#End If
        Dim Res As Long
        hWnd = FindWindow("XLMAIN", Application.Caption)
        'Res = SendMessage(hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon)
        Res = SendMessage(hWnd, WM_SETICON, ICON_BIG, ByVal hIcon)
        Res = DrawMenuBar(hWnd)
End Sub

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As LongPtr) As Long
#Else
    Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
    Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
#End If
Const WM_SETICON As Long = &H80
Const ICON_SMALL As Long = 0
Const ICON_BIG As Long = 1

#If VBA7 Then
Sub XlMainIconSwitch(Optional ByVal hIcon As LongPtr = 0&)
 Dim hWnd As LongPtr
  
#Else
Sub XlMainIconSwitch(Optional ByVal hIcon As LongPtr = 0&)
    Dim hWnd As LongPtr
#End If
        Dim Res As LongPtr
        hWnd = FindWindow("XLMAIN", Application.Caption)
        'Res = SendMessage(hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon)
        Res = SendMessage(hWnd, WM_SETICON, ICON_BIG, ByVal hIcon)
        Res = DrawMenuBar(hWnd)
End Sub

'...
'...
#Else
Sub XlMainIconSwitch(Optional ByVal hIcon As LongPtr = 0&)
    Dim hWnd As LongPtr 'FAUX!!!!!!!!!!!!!!!!!!!!!!!!!!'
#End If