Bonjour,
Il ya quelques jours j'avais vu une macro permettant de changer le logo XL
de la barre de titre pour un icone de son choix pour autant que le fichier
icone soit dans le même répertoire.
J'ai épluché Excelabo en vain (icone, logo).
Est-ce que quelqu'un a vu ce truc?
Merci de vos suggestions.
Bonjour,
Il ya quelques jours j'avais vu une macro permettant de changer le logo XL
de la barre de titre pour un icone de son choix pour autant que le fichier
icone soit dans le même répertoire.
J'ai épluché Excelabo en vain (icone, logo).
Est-ce que quelqu'un a vu ce truc?
Merci de vos suggestions.
Bonjour,
Il ya quelques jours j'avais vu une macro permettant de changer le logo XL
de la barre de titre pour un icone de son choix pour autant que le fichier
icone soit dans le même répertoire.
J'ai épluché Excelabo en vain (icone, logo).
Est-ce que quelqu'un a vu ce truc?
Merci de vos suggestions.
bonjour,
'This code shows you how to change the Excel icon:
'Jim Rech, mpep
'Attention : lancer ces procédures depuis Excel et non le VBE
Declare Function GetActiveWindow32 Lib "USER32" Alias _
"GetActiveWindow" () As Integer
Declare Function SendMessage32 Lib "USER32" Alias _
"SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
bonjour,
Declare Function ExtractIcon32 Lib "SHELL32.DLL" Alias _
"ExtractIconA" (ByVal hInst As Long, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As Long
Sub ChangeXLIcon()
Dim h32NewIcon As Long
Dim h32WndXLMAIN As Long
h32NewIcon = ExtractIcon32(0, "Notepad.exe", 0)
h32WndXLMAIN = GetActiveWindow32()
SendMessage32 h32WndXLMAIN, &H80, 1, h32NewIcon 'Icon big
' SendMessage32 h32WndXLMAIN, &H80, 0, h32NewIcon 'Icon small
End Sub
Sub RestaureXLIcon()
Dim h32NewIcon As Long
Dim h32WndXLMAIN As Long
h32NewIcon = ExtractIcon32(0, "Excel.exe", 0)
h32WndXLMAIN = GetActiveWindow32()
SendMessage32 h32WndXLMAIN, &H80, 1, h32NewIcon 'Icon big
' SendMessage32 h32WndXLMAIN, &H80, 0, h32NewIcon 'Icon small
End Sub
ou
Attribute VB_Name = "ChangeIconeExcel2"
'Changer l'icone d'Excel
'Orlando Magalhães Filho, mpep
'(Thanks to Bill Manville)
Declare Function GetActiveWindow Lib "user32" () As Long
Declare Function GetFocus Lib "user32" () As Long
Declare Function GetWindowWord Lib "user32" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Integer
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Integer, ByVal lParam As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As
String) As Long
Declare Function ExtractIcon Lib "Shell32.dll" Alias "ExtractIconA" _
(ByVal hInst As Long, ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As Long
Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
Declare Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal hwnd As
Long) As Long
'
' API Constants
'
Global Const WM_SETICON = &H80
Global Const GWL_HINSTANCE = (-6)
Global Const GWL_STYLE = (-16)
Global Const WS_SYSMENU = &H80000
Public Const SM_CXICON = 11
Public Const SM_CYICON = 12
Public Const SM_CXSMICON = 49
Public Const SM_CYSMICON = 50
Const SW_SHOW = 5
'
' Various Windows Handles
'
Dim hPreviousXLMAINBigIcon As Long
Dim hPreviousXLMAINSmallIcon As Long
Dim hPreviousEXCEL9BigIcon As Long
Dim hPreviousEXCEL9SmallIcon As Long
Dim hNewIcon As Long
Dim hInstanceExcel As Integer
Dim hWndXLMAIN As Long
Dim hWndEXCEL9 As Long
Sub SetPerceptorIcon()
Dim theIconSource As String
Dim theIconIndex As Long
Dim istat As Long
theIconSource = "C:WindowsWinupd.ico" 'ThisWorkbook.Path &
"Applicat.ico"
' can be any valid windows icon source(.EXE, .DLL, .ICO)
theIconIndex = 0
' the index to the icon within the source
' If this index is 0, the ExtractIcon function
' returns the first icon in the source
istat = SetNewIcon(theIconSource, theIconIndex) ' do the deed
End Sub
' A routine to change the standard Excel Icons
Function SetNewIcon(theIconSource As String, theIconIndex As Long) As Long
Dim L As Long
' Get handle to active window (Classname XLMAIN).
hWndXLMAIN = FindWindow("XLMAIN", Application.Caption)
L = SetFocusAPI(hWndXLMAIN)
hWndEXCEL9 = GetFocus()
' Getthe icon from the source
hNewIcon = ExtractIcon(0, theIconSource, 0)
SetNewIcon = hNewIcon ' return code from
function
If hNewIcon = Null Or hNewIcon = 1 Then
' 1 means invalid icon source, 0means no icons in source
MsgBox "icon not found"
GoTo TidyUp
End If
hPreviousXLMAINBigIcon = SendMessage(hWndXLMAIN, WM_SETICON, 1,
hNewIcon) ' Big Icon
hPreviousXLMAINSmallIcon = SendMessage(hWndXLMAIN, WM_SETICON, 0,
hNewIcon) ' Small Icon
hPreviousEXCEL9BigIcon = SendMessage(hWndEXCEL9, WM_SETICON, 1,
hNewIcon) ' Big Icon
hPreviousEXCEL9SmallIcon = SendMessage(hWndEXCEL9, WM_SETICON, 0,
hNewIcon) ' Small Icon
TidyUp:
End Function
'
' A routine to restore the standard Excel Icons
Sub restoreXLIcon()
Dim hIcon As Long
Dim lRetv As Long
hIcon = SendMessage(hWndXLMAIN, WM_SETICON, True,
hPreviousXLMAINBigIcon) ' restore Big Icon
hIcon = SendMessage(hWndXLMAIN, WM_SETICON, False,
hPreviousXLMAINSmallIcon) ' restore Small Icon
hIcon = SendMessage(hWndEXCEL9, WM_SETICON, True,
hPreviousEXCEL9BigIcon) ' restore Big Icon
hIcon = SendMessage(hWndEXCEL9, WM_SETICON, False,
hPreviousEXCEL9SmallIcon) ' restore Small Icon
lRetv = DestroyIcon(hIcon) ' I think this is necessary to free
'memory reserved in ExtractIcon
End Sub
ou
Attribute VB_Name = "ChangerLogoExcel"
'changer le logo d'Excel
'------------------------------------------------
'this code sets the main Excel icon to the .ico file supplied
'(The Declares lines are one line each)
'Stephen Bullen, Microsoft.public.excel.programming, 98/04/08
'Get the handle for a window
Declare Function wapiFindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'Extract an icon from a file
Declare Function wapiExtractIcon Lib "shell32.dll" Alias "ExtractIconA" _
(ByVal hInst As Long, ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As Long
'Send a Windows message
Declare Function wapiSendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, _
ByVal lParam As Long) As Long
Public Const WM_SETICON = &H80
Sub ChangeIcon()
Dim sName As String
sName = "C:club.ico"
'Uncomment the next line to restore the standard Excel icon. Give the
right Path
'sName = "F:OfficeExcel.exe"
Call procSetIcons(sName)
End Sub
Sub procSetIcons(sIconPath)
Dim a As Long, ihWnd As Long, ihIcon As Long
'Get the handle of the Excel window
ihWnd = wapiFindWindow("XLMAIN", Application.Caption)
'Get the icon from the source
ihIcon = wapiExtractIcon(0, sIconPath, 0)
'1 means invalid icon source, 0 means no icons in
source
If ihIcon > 1 Then
'Set the big (32x32) and small (16x16) icons
a = wapiSendMessage(ihWnd, WM_SETICON, True, ihIcon)
a = wapiSendMessage(ihWnd, WM_SETICON, False, ihIcon)
End If
End Sub
'------------------------------------------------
A+Bonjour,
Il ya quelques jours j'avais vu une macro permettant de changer le logo
XL de la barre de titre pour un icone de son choix pour autant que le
fichier icone soit dans le même répertoire.
J'ai épluché Excelabo en vain (icone, logo).
Est-ce que quelqu'un a vu ce truc?
Merci de vos suggestions.
bonjour,
'This code shows you how to change the Excel icon:
'Jim Rech, mpep
'Attention : lancer ces procédures depuis Excel et non le VBE
Declare Function GetActiveWindow32 Lib "USER32" Alias _
"GetActiveWindow" () As Integer
Declare Function SendMessage32 Lib "USER32" Alias _
"SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
bonjour,
Declare Function ExtractIcon32 Lib "SHELL32.DLL" Alias _
"ExtractIconA" (ByVal hInst As Long, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As Long
Sub ChangeXLIcon()
Dim h32NewIcon As Long
Dim h32WndXLMAIN As Long
h32NewIcon = ExtractIcon32(0, "Notepad.exe", 0)
h32WndXLMAIN = GetActiveWindow32()
SendMessage32 h32WndXLMAIN, &H80, 1, h32NewIcon 'Icon big
' SendMessage32 h32WndXLMAIN, &H80, 0, h32NewIcon 'Icon small
End Sub
Sub RestaureXLIcon()
Dim h32NewIcon As Long
Dim h32WndXLMAIN As Long
h32NewIcon = ExtractIcon32(0, "Excel.exe", 0)
h32WndXLMAIN = GetActiveWindow32()
SendMessage32 h32WndXLMAIN, &H80, 1, h32NewIcon 'Icon big
' SendMessage32 h32WndXLMAIN, &H80, 0, h32NewIcon 'Icon small
End Sub
ou
Attribute VB_Name = "ChangeIconeExcel2"
'Changer l'icone d'Excel
'Orlando Magalhães Filho, mpep
'(Thanks to Bill Manville)
Declare Function GetActiveWindow Lib "user32" () As Long
Declare Function GetFocus Lib "user32" () As Long
Declare Function GetWindowWord Lib "user32" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Integer
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Integer, ByVal lParam As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As
String) As Long
Declare Function ExtractIcon Lib "Shell32.dll" Alias "ExtractIconA" _
(ByVal hInst As Long, ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As Long
Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
Declare Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal hwnd As
Long) As Long
'
' API Constants
'
Global Const WM_SETICON = &H80
Global Const GWL_HINSTANCE = (-6)
Global Const GWL_STYLE = (-16)
Global Const WS_SYSMENU = &H80000
Public Const SM_CXICON = 11
Public Const SM_CYICON = 12
Public Const SM_CXSMICON = 49
Public Const SM_CYSMICON = 50
Const SW_SHOW = 5
'
' Various Windows Handles
'
Dim hPreviousXLMAINBigIcon As Long
Dim hPreviousXLMAINSmallIcon As Long
Dim hPreviousEXCEL9BigIcon As Long
Dim hPreviousEXCEL9SmallIcon As Long
Dim hNewIcon As Long
Dim hInstanceExcel As Integer
Dim hWndXLMAIN As Long
Dim hWndEXCEL9 As Long
Sub SetPerceptorIcon()
Dim theIconSource As String
Dim theIconIndex As Long
Dim istat As Long
theIconSource = "C:WindowsWinupd.ico" 'ThisWorkbook.Path &
"Applicat.ico"
' can be any valid windows icon source(.EXE, .DLL, .ICO)
theIconIndex = 0
' the index to the icon within the source
' If this index is 0, the ExtractIcon function
' returns the first icon in the source
istat = SetNewIcon(theIconSource, theIconIndex) ' do the deed
End Sub
' A routine to change the standard Excel Icons
Function SetNewIcon(theIconSource As String, theIconIndex As Long) As Long
Dim L As Long
' Get handle to active window (Classname XLMAIN).
hWndXLMAIN = FindWindow("XLMAIN", Application.Caption)
L = SetFocusAPI(hWndXLMAIN)
hWndEXCEL9 = GetFocus()
' Getthe icon from the source
hNewIcon = ExtractIcon(0, theIconSource, 0)
SetNewIcon = hNewIcon ' return code from
function
If hNewIcon = Null Or hNewIcon = 1 Then
' 1 means invalid icon source, 0means no icons in source
MsgBox "icon not found"
GoTo TidyUp
End If
hPreviousXLMAINBigIcon = SendMessage(hWndXLMAIN, WM_SETICON, 1,
hNewIcon) ' Big Icon
hPreviousXLMAINSmallIcon = SendMessage(hWndXLMAIN, WM_SETICON, 0,
hNewIcon) ' Small Icon
hPreviousEXCEL9BigIcon = SendMessage(hWndEXCEL9, WM_SETICON, 1,
hNewIcon) ' Big Icon
hPreviousEXCEL9SmallIcon = SendMessage(hWndEXCEL9, WM_SETICON, 0,
hNewIcon) ' Small Icon
TidyUp:
End Function
'
' A routine to restore the standard Excel Icons
Sub restoreXLIcon()
Dim hIcon As Long
Dim lRetv As Long
hIcon = SendMessage(hWndXLMAIN, WM_SETICON, True,
hPreviousXLMAINBigIcon) ' restore Big Icon
hIcon = SendMessage(hWndXLMAIN, WM_SETICON, False,
hPreviousXLMAINSmallIcon) ' restore Small Icon
hIcon = SendMessage(hWndEXCEL9, WM_SETICON, True,
hPreviousEXCEL9BigIcon) ' restore Big Icon
hIcon = SendMessage(hWndEXCEL9, WM_SETICON, False,
hPreviousEXCEL9SmallIcon) ' restore Small Icon
lRetv = DestroyIcon(hIcon) ' I think this is necessary to free
'memory reserved in ExtractIcon
End Sub
ou
Attribute VB_Name = "ChangerLogoExcel"
'changer le logo d'Excel
'------------------------------------------------
'this code sets the main Excel icon to the .ico file supplied
'(The Declares lines are one line each)
'Stephen Bullen, Microsoft.public.excel.programming, 98/04/08
'Get the handle for a window
Declare Function wapiFindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'Extract an icon from a file
Declare Function wapiExtractIcon Lib "shell32.dll" Alias "ExtractIconA" _
(ByVal hInst As Long, ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As Long
'Send a Windows message
Declare Function wapiSendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, _
ByVal lParam As Long) As Long
Public Const WM_SETICON = &H80
Sub ChangeIcon()
Dim sName As String
sName = "C:club.ico"
'Uncomment the next line to restore the standard Excel icon. Give the
right Path
'sName = "F:OfficeExcel.exe"
Call procSetIcons(sName)
End Sub
Sub procSetIcons(sIconPath)
Dim a As Long, ihWnd As Long, ihIcon As Long
'Get the handle of the Excel window
ihWnd = wapiFindWindow("XLMAIN", Application.Caption)
'Get the icon from the source
ihIcon = wapiExtractIcon(0, sIconPath, 0)
'1 means invalid icon source, 0 means no icons in
source
If ihIcon > 1 Then
'Set the big (32x32) and small (16x16) icons
a = wapiSendMessage(ihWnd, WM_SETICON, True, ihIcon)
a = wapiSendMessage(ihWnd, WM_SETICON, False, ihIcon)
End If
End Sub
'------------------------------------------------
A+
Bonjour,
Il ya quelques jours j'avais vu une macro permettant de changer le logo
XL de la barre de titre pour un icone de son choix pour autant que le
fichier icone soit dans le même répertoire.
J'ai épluché Excelabo en vain (icone, logo).
Est-ce que quelqu'un a vu ce truc?
Merci de vos suggestions.
bonjour,
'This code shows you how to change the Excel icon:
'Jim Rech, mpep
'Attention : lancer ces procédures depuis Excel et non le VBE
Declare Function GetActiveWindow32 Lib "USER32" Alias _
"GetActiveWindow" () As Integer
Declare Function SendMessage32 Lib "USER32" Alias _
"SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
bonjour,
Declare Function ExtractIcon32 Lib "SHELL32.DLL" Alias _
"ExtractIconA" (ByVal hInst As Long, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As Long
Sub ChangeXLIcon()
Dim h32NewIcon As Long
Dim h32WndXLMAIN As Long
h32NewIcon = ExtractIcon32(0, "Notepad.exe", 0)
h32WndXLMAIN = GetActiveWindow32()
SendMessage32 h32WndXLMAIN, &H80, 1, h32NewIcon 'Icon big
' SendMessage32 h32WndXLMAIN, &H80, 0, h32NewIcon 'Icon small
End Sub
Sub RestaureXLIcon()
Dim h32NewIcon As Long
Dim h32WndXLMAIN As Long
h32NewIcon = ExtractIcon32(0, "Excel.exe", 0)
h32WndXLMAIN = GetActiveWindow32()
SendMessage32 h32WndXLMAIN, &H80, 1, h32NewIcon 'Icon big
' SendMessage32 h32WndXLMAIN, &H80, 0, h32NewIcon 'Icon small
End Sub
ou
Attribute VB_Name = "ChangeIconeExcel2"
'Changer l'icone d'Excel
'Orlando Magalhães Filho, mpep
'(Thanks to Bill Manville)
Declare Function GetActiveWindow Lib "user32" () As Long
Declare Function GetFocus Lib "user32" () As Long
Declare Function GetWindowWord Lib "user32" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Integer
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Integer, ByVal lParam As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As
String) As Long
Declare Function ExtractIcon Lib "Shell32.dll" Alias "ExtractIconA" _
(ByVal hInst As Long, ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As Long
Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
Declare Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal hwnd As
Long) As Long
'
' API Constants
'
Global Const WM_SETICON = &H80
Global Const GWL_HINSTANCE = (-6)
Global Const GWL_STYLE = (-16)
Global Const WS_SYSMENU = &H80000
Public Const SM_CXICON = 11
Public Const SM_CYICON = 12
Public Const SM_CXSMICON = 49
Public Const SM_CYSMICON = 50
Const SW_SHOW = 5
'
' Various Windows Handles
'
Dim hPreviousXLMAINBigIcon As Long
Dim hPreviousXLMAINSmallIcon As Long
Dim hPreviousEXCEL9BigIcon As Long
Dim hPreviousEXCEL9SmallIcon As Long
Dim hNewIcon As Long
Dim hInstanceExcel As Integer
Dim hWndXLMAIN As Long
Dim hWndEXCEL9 As Long
Sub SetPerceptorIcon()
Dim theIconSource As String
Dim theIconIndex As Long
Dim istat As Long
theIconSource = "C:WindowsWinupd.ico" 'ThisWorkbook.Path &
"Applicat.ico"
' can be any valid windows icon source(.EXE, .DLL, .ICO)
theIconIndex = 0
' the index to the icon within the source
' If this index is 0, the ExtractIcon function
' returns the first icon in the source
istat = SetNewIcon(theIconSource, theIconIndex) ' do the deed
End Sub
' A routine to change the standard Excel Icons
Function SetNewIcon(theIconSource As String, theIconIndex As Long) As Long
Dim L As Long
' Get handle to active window (Classname XLMAIN).
hWndXLMAIN = FindWindow("XLMAIN", Application.Caption)
L = SetFocusAPI(hWndXLMAIN)
hWndEXCEL9 = GetFocus()
' Getthe icon from the source
hNewIcon = ExtractIcon(0, theIconSource, 0)
SetNewIcon = hNewIcon ' return code from
function
If hNewIcon = Null Or hNewIcon = 1 Then
' 1 means invalid icon source, 0means no icons in source
MsgBox "icon not found"
GoTo TidyUp
End If
hPreviousXLMAINBigIcon = SendMessage(hWndXLMAIN, WM_SETICON, 1,
hNewIcon) ' Big Icon
hPreviousXLMAINSmallIcon = SendMessage(hWndXLMAIN, WM_SETICON, 0,
hNewIcon) ' Small Icon
hPreviousEXCEL9BigIcon = SendMessage(hWndEXCEL9, WM_SETICON, 1,
hNewIcon) ' Big Icon
hPreviousEXCEL9SmallIcon = SendMessage(hWndEXCEL9, WM_SETICON, 0,
hNewIcon) ' Small Icon
TidyUp:
End Function
'
' A routine to restore the standard Excel Icons
Sub restoreXLIcon()
Dim hIcon As Long
Dim lRetv As Long
hIcon = SendMessage(hWndXLMAIN, WM_SETICON, True,
hPreviousXLMAINBigIcon) ' restore Big Icon
hIcon = SendMessage(hWndXLMAIN, WM_SETICON, False,
hPreviousXLMAINSmallIcon) ' restore Small Icon
hIcon = SendMessage(hWndEXCEL9, WM_SETICON, True,
hPreviousEXCEL9BigIcon) ' restore Big Icon
hIcon = SendMessage(hWndEXCEL9, WM_SETICON, False,
hPreviousEXCEL9SmallIcon) ' restore Small Icon
lRetv = DestroyIcon(hIcon) ' I think this is necessary to free
'memory reserved in ExtractIcon
End Sub
ou
Attribute VB_Name = "ChangerLogoExcel"
'changer le logo d'Excel
'------------------------------------------------
'this code sets the main Excel icon to the .ico file supplied
'(The Declares lines are one line each)
'Stephen Bullen, Microsoft.public.excel.programming, 98/04/08
'Get the handle for a window
Declare Function wapiFindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'Extract an icon from a file
Declare Function wapiExtractIcon Lib "shell32.dll" Alias "ExtractIconA" _
(ByVal hInst As Long, ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As Long
'Send a Windows message
Declare Function wapiSendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, _
ByVal lParam As Long) As Long
Public Const WM_SETICON = &H80
Sub ChangeIcon()
Dim sName As String
sName = "C:club.ico"
'Uncomment the next line to restore the standard Excel icon. Give the
right Path
'sName = "F:OfficeExcel.exe"
Call procSetIcons(sName)
End Sub
Sub procSetIcons(sIconPath)
Dim a As Long, ihWnd As Long, ihIcon As Long
'Get the handle of the Excel window
ihWnd = wapiFindWindow("XLMAIN", Application.Caption)
'Get the icon from the source
ihIcon = wapiExtractIcon(0, sIconPath, 0)
'1 means invalid icon source, 0 means no icons in
source
If ihIcon > 1 Then
'Set the big (32x32) and small (16x16) icons
a = wapiSendMessage(ihWnd, WM_SETICON, True, ihIcon)
a = wapiSendMessage(ihWnd, WM_SETICON, False, ihIcon)
End If
End Sub
'------------------------------------------------
A+Bonjour,
Il ya quelques jours j'avais vu une macro permettant de changer le logo
XL de la barre de titre pour un icone de son choix pour autant que le
fichier icone soit dans le même répertoire.
J'ai épluché Excelabo en vain (icone, logo).
Est-ce que quelqu'un a vu ce truc?
Merci de vos suggestions.