Atualizar código para funcionar em sistema 32 e 64 bits
Enviado: Sáb Dez 15, 2018 9:12 pm
Olá prezados(as).
Estive procurando um código para que eu pudesse alterar o ícone (da barra de tarefas no Windows) do meu sisteminha em excel vba, encontrei esse código abaixo, mas quando clico para o sisteminha funcionar surge mensagem informando para atualizar para 64 bits ou que meu sistema é incompatível...
Alguém saberia como posso alterar esse código para que ele funcione tanto no sistema de 32 bits como no de 64 ?
Códigos:
'******Código para EstaPasta_de_trabalho******
Option Explicit
Private Sub Workbook_Open()
Application.Caption = " Meu Aplicativo Personalizado"
ChangeApplicationIcon
End Sub
'*****************************************
'************Códido do Módulo**************** (o que está dando erro:)
Option Explicit
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
Declare Function ExtractIcon32 Lib "SHELL32.DLL" Alias _
"ExtractIconA" (ByVal hInst As Long, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As Long
Sub ChangeApplicationIcon()
Dim Icon&
'Muda o ícone para o do Bloco de Notas
'Mude para o arquivo que contém o ícone desejado (.ico)
Const NewIcon$ = "Notepad.exe"
Icon = ExtractIcon32(0, NewIcon, 0)
SendMessage32 GetActiveWindow32(), &H80, 1, Icon '< 1 = big Icon
SendMessage32 GetActiveWindow32(), &H80, 0, Icon '< 0 = small Icon
End Sub
'*****************************************
Estive procurando um código para que eu pudesse alterar o ícone (da barra de tarefas no Windows) do meu sisteminha em excel vba, encontrei esse código abaixo, mas quando clico para o sisteminha funcionar surge mensagem informando para atualizar para 64 bits ou que meu sistema é incompatível...
Alguém saberia como posso alterar esse código para que ele funcione tanto no sistema de 32 bits como no de 64 ?
Códigos:
'******Código para EstaPasta_de_trabalho******
Option Explicit
Private Sub Workbook_Open()
Application.Caption = " Meu Aplicativo Personalizado"
ChangeApplicationIcon
End Sub
'*****************************************
'************Códido do Módulo**************** (o que está dando erro:)
Option Explicit
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
Declare Function ExtractIcon32 Lib "SHELL32.DLL" Alias _
"ExtractIconA" (ByVal hInst As Long, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As Long
Sub ChangeApplicationIcon()
Dim Icon&
'Muda o ícone para o do Bloco de Notas
'Mude para o arquivo que contém o ícone desejado (.ico)
Const NewIcon$ = "Notepad.exe"
Icon = ExtractIcon32(0, NewIcon, 0)
SendMessage32 GetActiveWindow32(), &H80, 1, Icon '< 1 = big Icon
SendMessage32 GetActiveWindow32(), &H80, 0, Icon '< 0 = small Icon
End Sub
'*****************************************