Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function SendMessageA Lib "user32" (ByVal hwnd As LongPtr, ByVal wMsg As LongPtr, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function ExtractIconA Lib "shell32.dll" (ByVal hInst As LongPtr, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As LongPtr
#Else
Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessageA Lib "user32" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ExtractIconA Lib "shell32.dll" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
#End If
Const WM_SETICON As Long = &H80
Private Sub CommandButton1_Click()
'marche pas
Dim hwnd As LongPtr, hIcon As LongPtr
hIcon = ExtractIconA(0, "C:\Program Files (x86)\Microsoft Office\Office15\EXCEL.EXE", 1)
hwnd = FindWindowA(vbNullString, Me.Caption) 'determine la fenêtre
SendMessageA hwnd, WM_SETICON, True, hIcon 'on met le petit icon
SendMessageA hwnd, WM_SETICON, False, hIcon 'on met le gros icon
DrawMenuBar hwnd
End Sub
Private Sub CommandButton2_Click()
'ca marche
Dim fichier
fichier = "C:\Program Files (x86)\Microsoft Office\Office15\EXCEL.EXE"
hwnd& = ExecuteExcel4Macro("CALL(""user32"",""GetActiveWindow"",""JCC"")") 'api GetActiveWindow
hIcon = ExecuteExcel4Macro("CALL(""shell32"",""ExtractIconA"",""JJCJ""," & 0 & ",""" & fichier & """," & 0 & ")")
ExecuteExcel4Macro "CALL(""user32"",""SendMessageA"",""JJJJJ""," & hwnd & "," & &H80 & "," & 0 & "," & hIcon & ")"
ExecuteExcel4Macro "CALL(""user32"",""SendMessageA"",""JJJJJ""," & hwnd & "," & &H80 & "," & 1 & "," & hIcon & ")"
End Sub