VBA Excel - Colocando um Ícone personalizado no Excel - Change Excel Icon


Sim, colocar um ícone que identifique sua aplicação pode dar uma visão mais profissional a ela. Existem usuários mais, digamos, caprichosos que gostam e se apegam a estes detalhes. Por isso precisamos desenvolver uma visão vendedora dos nossos produtos, melhorar o modo como tratamos os nossos softwares pode implicar em distribuirmos mais cópias de uma aplicação e até mesmo massificá-la num departamento ou empresa. Sim, é apenas um detalhe, mas pode inspirá-lo a alterar outros aspectos das suas aplicações.

Há alguns anos construí uma aplicação que interagia com diversos Workbooks diferentes: Ao passo que escolhia os diferentes relatórios na interface principal, fazia com que as sub-interfaces como que se dissolvessem enquanto um processo contrário reconstruía a interface escolhida. 

Recurso simples? Sim.

O acesso era mais demorado? Sim, mas o usuário gostou muito

Talvez porque fosse de uma agência de propaganda. Enfim, alguns toques de requinte podem abrir as portas para a sua aplicação ser aceita, distribuida e comentada. Seguem códigos:

Open an Excel workbook
Select Tools/Macro/Visual Basic Editor
In the VBE window, select View/Project Explorer
Select the 'ThisWorkbook' Module, copy and paste the code for it from above
Select Insert/Module, copy and paste the code for module1 into this module.
Now select File/Close and Return To Microsoft Excel
Save your work and close the workbook.

O ícone pode ser mudado a qualquer momento:
Option Explicit 
Private Sub Workbook_Open() 
    Application.Caption = " My Personalized Workbook" 
    ChangeApplicationIcon 
End Sub 

Código par o módulo
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& 
     
     '*****Change Icon To Suit*******
    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 


Reference: Walk

Tags: VBA, Excel, Icon, ícone, image, API, DLL, Shell32.dll, J Walk

Nenhum comentário:

Postar um comentário

diHITT - Notícias