VBA Excel - Inserindo icone em suas aplicações

| Blog Office VBA | Blog Excel | Blog Access |

Digamos que você tenha diversas planilhas abertas no computador neste momento.

Cada uma delas com conteúdos totalmente distintos. Não seria bom se você pudesse identificá-las somente olhando para os seus ícones na barra do Windows? Como podemos fazer isso?

Na verdade não requer prática, nem tão pouco experiência, basta que siga os passos abaixo:

Crie um novo módulo com um nome como: mdl_Functions_Icon

Dentro do módulo cole o código abaixo:

CÓDIGO: 


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

Function ChangeApplicationIcon()
    ' Author:                     Date:               Contact:                 URL:
    ' André Bernardes             22/11/2010 13:43   bernardess@gmail.com     https://sites.google.com/site/vbabernardes/
    ' Carrega o icone identificando a planilha.
    ' Listening:

    Dim Icon& ' Pegue o ícone de outro aplicativo como abaixo:
    
    Const NewIcon$ = "C:\PlanIcons\DashBoard.ico"  ' Um arquivo .ICO em um diretório: '
    
    Let Icon = ExtractIcon32(0, NewIcon, 0)
    
    SendMessage32 GetActiveWindow32(), &H80, 1, Icon
End Function


Na pasta de inicialização da sua planilha faça uma chamada a esta função, como demonstrado abaixo:

CÓDIGO: 


Private Sub Workbook_Open()
    ' Author:                     Date:               Contact:                 URL:
    ' André Bernardes             27/09/2010 09:07   bernardess@gmail.com     https://sites.google.com/site/vbabernardes/
    ' Abre a planilha para acesso a dados.
    ' Listening: Don´t Give Hate a Chance - Jamiroquai.

    Let Application.ScreenUpdating = False
    Let Application.Caption = ".: DashBoard®"
    Let Application.StatusBar = "A&A - In Any Place®"

    Call ChangeApplicationIcon

    Sheets("Dashboard").Select
    ActiveSheet.Outline.ShowLevels RowLevels:=1
    
    frmSplash.Show

    Sheets("Menu").Select

    Let Application.ScreenUpdating = True
End Sub

Pronto!

Todas as suas aplicações podem ter ícones distintos, identificando-as mais facilmente até mesmo para seus clientes.

Tags: Bernardes, VBA, Office, Excel, worksheets, sheets, ws, insert, inserindo, pasta