✔ Programação GLOBAL®: VBA Excel - Colocando um Ícone personalizado no Excel

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

| Blog Office VBA | Blog Excel | Blog Access |

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