Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Atualizar código para funcionar em sistema 32 e 64 bits

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
George2342
Colaborador
Colaborador
Mensagens: 23
Registrado em: Qua Dez 05, 2018 3:29 pm

Atualizar código para funcionar em sistema 32 e 64 bits

Mensagem por George2342 »

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
'*****************************************


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Avatar do usuário
Mikel Silveira Fraga
Jedi
Jedi
Mensagens: 1173
Registrado em: Sex Mai 27, 2011 3:27 pm
Localização: Governador Valadares - MG
Contato:

Re: Atualizar código para funcionar em sistema 32 e 64 bits

Mensagem por Mikel Silveira Fraga »

Gerorge, boa noite meu amigo.

Bem, esse erro realmente ocorre devido incompatibilidades das arquiteturas do Office. O bom que esse caso tem como reverter.

Tente alterar essa parte do código:

Código: Selecionar todos

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 
Para que fique desse jeito:

Código: Selecionar todos

#If VBA7 Then         ' Avalia as versões do Office 2010+

Declare PtrSafe Function GetActiveWindow32 Lib "USER32" Alias _
"GetActiveWindow" () As Integer 

Declare PtrSafe 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 PtrSafe Function ExtractIcon32 Lib "SHELL32.DLL" Alias _
"ExtractIconA" (ByVal hInst As Long, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As Long 

#ElseIf VBA6 Then     ' Avalia as versões do Office 2007-

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 

#End If
Com essa mudança, o código irá funcionar tanto em 32 bits como em 64 bits.

Espero que tenha ajudado. Abraços e quaisquer dúvidas, a disposição.


George2342
Colaborador
Colaborador
Mensagens: 23
Registrado em: Qua Dez 05, 2018 3:29 pm

Re: Atualizar código para funcionar em sistema 32 e 64 bits

Mensagem por George2342 »

Obrigado, mas infelizmente não funcionou. O símbolo do excel continua na barra de tarefas do windows, acredito que essa "função" de alterar esse ícone não exista... Já tentei de tudo.


Avatar do usuário
Mikel Silveira Fraga
Jedi
Jedi
Mensagens: 1173
Registrado em: Sex Mai 27, 2011 3:27 pm
Localização: Governador Valadares - MG
Contato:

Re: Atualizar código para funcionar em sistema 32 e 64 bits

Mensagem por Mikel Silveira Fraga »

George, boa noite.

Agora entendi que o Icon que deseja muda na verdade é o da barra de tarefas do Windows, e não o icone na barra de título.

Para esse seu caso, ainda não vi API´s ou qualquer outro recurso que permita esse tipo de personalização.

Caso eu encontre algum código que faça essa mudança, postarei aqui no fórum.

No mais, forte abraço e se cuida.


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


George2342
Colaborador
Colaborador
Mensagens: 23
Registrado em: Qua Dez 05, 2018 3:29 pm

Re: Atualizar código para funcionar em sistema 32 e 64 bits

Mensagem por George2342 »

Boa noite prezado Mikel.

Realente, já tentei de tudo e nunca consegui, também nunca vi API's para tal.
Mas muito obrigado pela disposição em ajudar.


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder