Este fórum está sendo desativado

[UngerSantos]

Este código corre bem em sistemas de 64 e 32, somente altera o icon pequeno no excel e o grande nao altera, somente no meu office 2010. Quando corro em outro office 2013 ou 2007 nao altera o Icon grande, será que alguém poderá ajudar
Abraços
Joao Santos

Option Explicit

#If Win64 Then

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public Declare PtrSafe Function SendMessageA Lib "user32" (ByVal hWnd As LongPtr, ByVal wMsg As Long, _
ByVal wParam As LongPtr, lParam As Any) As LongPtr

Private Declare PtrSafe Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" _
(ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long


#Else


Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" _
(ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long

Private 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

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

#End If

Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0
Private Const ICON_BIG = 1

Sub setExcelIcon(Optional stFileName As String = "", Optional strIconIndex As Long = 0, Optional bSetBigIcon As Boolean = False, Optional bSetSmallIcon As Boolean = True)

Dim hIcon As Long
Dim hwndXLApp As Long


On Error Resume Next

hwndXLApp = FindWindow("XLMAIN", Application.Caption)

If hwndXLApp <> 0 Then

Err.Clear

If stFileName = "" Then

strIconIndex = 8000

hIcon = ExtractIcon(0, Application.Path & Application.PathSeparator & "Excel.exe", strIconIndex)

ElseIf Dir(stFileName) = "" Then

hIcon = 0

ElseIf Err.Number <> 0 Then

hIcon = 0

Else

hIcon = ExtractIcon(0, stFileName, strIconIndex)

End If

If bSetBigIcon Then SendMessage hwndXLApp, WM_SETICON, ICON_BIG, hIcon

If bSetSmallIcon Then SendMessage hwndXLApp, WM_SETICON, ICON_SMALL, hIcon

End If
End Sub


Sub Change_Icon_1()
setExcelIcon ThisWorkbook.Path &\Logo_Icon_RED.ico"
End Sub

Sub Reset_Icons()
setExcelIcon ""
End Sub

[alexandrevba]

Boa noite!!

Favor ler as regras do fórum!!!
viewtopic.php?f=5&t=4

Regra nº 11:
Nós preferimos que os membros não façam postagens cruzadas (quando a mesma postagem é feita em diferentes fóruns). Mas quando isso ocorrer, os membros devem deixar claro os links para as postagens cruzadas.

Favor indicar as postagens cruzadas:
http://www.planilhando.com.br/forum/vie ... 10&t=23829
http://www.planilhando.com.br/forum/vie ... 10&t=23832


Att

[UngerSantos]

Bom depois de algum pensamento aqui encontrei a solução:

Adicionei estes campos:

SendMessage GetWindow(hwndIcon, GW_OWNER), WM_SETICON, ICON_SMALL, hwndIcon
SendMessage GetWindow(hwndIcon, GW_OWNER), WM_SETICON, ICON_BIG, hwndIcon

mais os outros dois acima

e alterei o option Explicit para :

Option Explicit

'Declaring the necessary API functions and constants.
#If VBA7 And Win64 Then

'For 64 bit Excel.
Private Declare PtrSafe Function ExtractIconA Lib "shell32.dll" _
(ByVal hInst As LongPtr, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As LongPtr

Private Declare PtrSafe Function SendMessageA Lib "user32" _
(ByVal hwnd As LongPtr, _
ByVal wMsg As Long, _
ByVal wParam As LongPtr, _
ByVal lParam As LongPtr) As LongPtr

Private Declare PtrSafe Function GetWindow _
Lib "user32.dll" Alias "GetWindowLongPtrA" ( _
ByVal hwndIcon As LongPtr, _
ByVal nIndex As Long) As LongPtr


Private Const ICON_SMALL As LongPtr = 0&
Private Const ICON_BIG As LongPtr = 1&
Dim hwndIcon As LongPtr

#Else

'For 32 bit Excel.
Private Declare Function ExtractIconA Lib "shell32.dll" _
(ByVal hInst As Long, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As Long

Private Declare Function SendMessageA Lib "user32" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long


Private Declare Function GetWindow _
Lib "user32.dll" Alias "GetWindowLongA" ( _
ByVal hwndIcon As Long, _
ByVal nIndex As Long) As Long

Private Const WM_SETICON As Long = &H80
Private Const ICON_SMALL As Long = 0&
Private Const ICON_BIG As Long = 1&
Private Const GW_OWNER = 2
Dim hwndIcon As Long

Obrigado a todos os que participaram, da próxima vez coloco o link à resposta.
Abraços
João Santos