Userform com icone próprio (RESOLVIDO)

[Erikson]

Boa terde Pessoal,

Alguem poderia separar os códigos VBA de cada função da userform que está residente na planilha em anexo? Pois gostaria de usar alguns recursos, principalmente o que faz a userform ter um icone na barras de tarefa do windows, estou realmente precisando atribuir essa funçao a uma das minhas forms.
O problema é que não consegui separar os códigos, pois há macros dentro da userform, declarações, modulo de classes, mta coisa interligada. Agradeço a quem conseguir.

[Mauro Coutinho]

Erikson, este exemplo é bem interessante, utiliza varias APIs do Windows, mas se for para o Icone, veja no tópico abaixo anexei dois exemplos v2003 e 2007 de como alterar o Icone, baixe de acordo com a versão que irá utilizar, pois apesar das rotinas serem as mesmas, tem algumas funcionalidades que não são compativeis entre as versões, nos arquivos tem um passo a passo com imagens de como fazer.

Alterar Icone Barra Titulo Excel
viewtopic.php?f=17&t=1327

Qualquer duvida, retorne

[Erikson]

Erikson, este exemplo é bem interessante, utiliza varias APIs do Windows, mas se for para o Icone, veja no tópico abaixo anexei dois exemplos v2003 e 2007 de como alterar o Icone, baixe de acordo com a versão que irá utilizar, pois apesar das rotinas serem as mesmas, tem algumas funcionalidades que não são compativeis entre as versões, nos arquivos tem um passo a passo com imagens de como fazer.

Alterar Icone Barra Titulo Excel
viewtopic.php?f=17&t=1327

Qualquer duvida, retorne

Eu quero é que na barra de tarefas do windows, (não do excel), a minha userforme tenha um icone individual, ou seja quando a planilha está aberta normalmente aparecerá o icone da janela do excel na barra de tarefas, quero q a userform tambem tenha um icone. Na planlha que anexei, isso foi possivel, veja que na userform da planilha ao clicar na caixa de seleção TASK BAR ICON, a userforme ganha um icone igual ao do excel na barra de tarefas do windows. Seu exemplo Mauro, infelizmente não é a resposta dessa questão.
Agradeço e aguardo seu retorno, e do pessoal do forum tambem.

[Melo]

Fale irmão Mauro, só na manhaaaaa
Vamos lá filhão
Erikson, vou aqui buscar lhe ajudar, certo
Vamos com calma e cautela para não escorregar......

Primeiro - temos um UserForm, um CheckBox1 e dois CommandButton1
Pois bem no UserForm inserimos o seguinte código

Código: Selecionar todos

Option Explicit
Dim mclsFormChanger As CFormChanger
Private Sub UserForm_Activate()
    Set mclsFormChanger = New CFormChanger
    cbIcon.Value = False
    Set mclsFormChanger.Form = Me
End Sub
Private Sub cbIcon_Change()
    mclsFormChanger.ShowIcon = cbIcon.Value
    If cbIcon.Value And mclsFormChanger.IconPath = "" Then btnChangeIcon_Click
    CheckEnabled
End Sub
Private Sub btnChangeIcon_Click()
    Dim vFile As Variant
    vFile = Application.GetOpenFilename("Icon files (*.ico;*.exe;*.dll),*.ico;*.exe;*.dll", 0, "Open Icon File", "Open", False)
    If vFile = False Then Exit Sub
    mclsFormChanger.IconPath = vFile
End Sub
Private Sub btnOK_Click()
    Unload Me
End Sub
Private Sub CheckEnabled()
    btnChangeIcon.Enabled = cbIcon.Value And cbIcon.Enabled

End Sub

Eita isso é um melzinho na chupeta em filhão . . .
Mais se acalme para não alterar seus batimentos cardíacos, muita calma nesta hora
Vamos para o próximo passo, estais pronto já tomou um pouco e água, molhou a cabecinha para esfriar, pois bem vamos lá

Agora vamos para a Classe, mais antes QUESTÃO DE VESTIBULAR para a provação, no código acima já foi feita a referencia para a Classe, QUAL SERIA O NOME DA CLASSE? A pergunta de Um Milhão de dólares, hei qual é?
Hummm, não sabeeeee, maaaissss não se preoculpe o titio vai lhe dizer, ou melhor lhe mostrar é é é é é é é, isso mesmo filho ” CFormChanger”

Aqui vamos disponibilizar o código . . . .

Código: Selecionar todos

Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hWndLock As Long) As Long

Private Const WS_EX_APPWINDOW As Long = &H40000  'Application Window: shown on taskbar
Private Const WS_EX_TOOLWINDOW As Long = &H80    'Tool Window: small titlebar

Private Const WM_SETICON = &H80

Dim mbSizeable As Boolean, mbCaption As Boolean, mbIcon As Boolean
Dim msIconPath As String
Dim mhWndForm As Long

Public Property Set Form(oForm As Object)
    If Val(Application.Version) < 9 Then
        mhWndForm = FindWindow("ThunderXFrame", oForm.Caption)    'XL97 Muito cuidado
    Else
        mhWndForm = FindWindow("ThunderDFrame", oForm.Caption)    'XL2000+ Muito cuidado
    End If
    ChangeIcon
End Property
Public Property Let ShowIcon(bIcon As Boolean)
    mbIcon = Not bIcon
    ChangeIcon
End Property
Public Property Get ShowIcon() As Boolean
    ShowIcon = (mbIcon <> 1)
End Property
Public Property Let IconPath(sNewPath As String)
    msIconPath = sNewPath
    ChangeIcon
End Property
Public Property Get IconPath() As String
    IconPath = msIconPath
End Property
Private Sub SetBit(ByRef lStyle As Long, ByVal lBit As Long, ByVal bOn As Boolean)
   If bOn Then
      lStyle = lStyle Or lBit
 Else
    lStyle = lStyle And Not lBit
 End If
End Sub
Private Sub ChangeIcon()
    Dim hIcon As Long
    On Error Resume Next
    If mhWndForm <> 0 Then
        Err.Clear
        If msIconPath = "" Then
            hIcon = 0
        ElseIf Dir(msIconPath) = "" Then
            hIcon = 0
        ElseIf Err.Number <> 0 Then
            hIcon = 0
        ElseIf Not mbIcon Then
            hIcon = ExtractIcon(0, msIconPath, 0)
        Else
            hIcon = 0
        End If
        SendMessage mhWndForm, WM_SETICON, True, hIcon
        SendMessage mhWndForm, WM_SETICON, False, hIcon
    End If

End Sub

Prontinho espero ter ajudado, hááá não deixe de acompanhar com a sua planilha. Espero ter ajudado.

Duvida
Aproveito para agradecer pelas ajudas que tenho recebido neste fórum.
MUITO OBRIGADO

Melo
Josielgestor.com.br

[joseA]

Que figura em meu.

Parabéns Melo pela sua maneira irreverente de esclarecer, ficou bem leve.

[Melo]

Que figura em meu.

Parabéns Melo pela sua maneira irreverente de esclarecer, ficou bem leve.

Obrigado irmão

Valeeeuuuuu

[Erikson]

Cara vc é meio maluco Rsss. Brincadeira, agradeço a explicação, mas ainda não deu certo para mim.
Não expliquei bem, vou ser mais direto! Tenho uma userform que inicia automaticamente e oculta o aplicativo excel quando abro meu projeto. Essa userform fica sem icone, resumindo preciso que a userform tenha um icone proprio, já abra tendo o icone na barra, ou seja sem precisar clicar em algo. Coloquei uma imagen descrevendo o que eu preciso.

[Melo]

Olá,

Filhão

O código que lhe passei antes, inseri uma imagem na barra do UserForm, quando clicado selecionado o Botão, para carregar automaticamente basta pegar o codigo de dentro do botão e inserir na "UserForm_initialize" ou também na "Workbook_Open", blz

Mas titio não que só a imagem quero que apareça o nome da Userform? Hum hum hum

Então deve ser o exemplo que vc postou com a imagem, correto?

Bem, se sim, então vamos lá

vc sabe que assim como no outro devemos trabalhar com API do Windows

Continuando . . .

O codigo da UserForm

Código: Selecionar todos

Option Explicit
Dim mclsFormChanger As CFormChanger
Private Sub UserForm_Activate()
    Set mclsFormChanger = New CFormChanger
    Set mclsFormChanger.Form = Me
End Sub
Private Sub UserForm_Terminate()
    Set mclsFormChanger = Nothing
End Sub
Private Sub cbTaskBar_Change()
    mclsFormChanger.ShowTaskBarIcon = cbTaskBar.Value
End Sub
Private Sub btnOK_Click()
    Unload Me
End Sub

Filhão muita atenção, analise o código com carinho para não se perder

É ou não É um melzinho na chupeta

agora vamos para o codigo da Classe

Código: Selecionar todos

Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long

Private Const GWL_STYLE As Long = (-16)
Private Const GWL_EXSTYLE As Long = (-20)

Private Const WS_EX_APPWINDOW As Long = &H40000
Private Const WS_EX_TOOLWINDOW As Long = &H80

Private Const SW_HIDE As Long = 0
Private Const SW_SHOW As Long = 5

Private Const WM_SETICON = &H80

Dim mbAppWindow As Boolean
Dim mbToolWindow As Boolean
Dim moForm As Object
Dim mhWndForm As Long

Public Property Set Form(oForm As Object)

    If Val(Application.Version) < 9 Then
        mhWndForm = FindWindow("ThunderXFrame", oForm.Caption)    'XL97
    Else
        mhWndForm = FindWindow("ThunderDFrame", oForm.Caption)    'XL2000+
    End If

    SetFormStyle

    If mbAppWindow Then ShowTaskBarIcon = True

End Property

Public Property Let ShowTaskBarIcon(bAppWindow As Boolean)

    mbAppWindow = bAppWindow

    If mhWndForm <> 0 Then

        ShowWindow mhWndForm, SW_HIDE

        SetFormStyle

        ShowWindow mhWndForm, SW_SHOW
    End If

End Property

Public Property Get ShowTaskBarIcon() As Boolean
    ShowTaskBarIcon = mbAppWindow
End Property

Private Sub SetFormStyle()

    Dim lStyle As Long, hMenu As Long

    If mhWndForm = 0 Then Exit Sub

    lStyle = GetWindowLong(mhWndForm, GWL_STYLE)
    
    SetWindowLong mhWndForm, GWL_STYLE, lStyle

    lStyle = GetWindowLong(mhWndForm, GWL_EXSTYLE)

    SetBit lStyle, WS_EX_APPWINDOW, mbAppWindow
    SetBit lStyle, WS_EX_TOOLWINDOW, mbToolWindow
    
    SetWindowLong mhWndForm, GWL_EXSTYLE, lStyle

End Sub
Private Sub SetBit(ByRef lStyle As Long, ByVal lBit As Long, ByVal bOn As Boolean)
    If bOn Then
        lStyle = lStyle Or lBit
    Else
        lStyle = lStyle And Not lBit
    End If
End Sub

Aiiii, que coisa filhão, vamos com muita calma

Você compreendeu o código? , NÃO!, então mantenha a calma criança que o papai vai iluminar . . .

Este codigo faz igual a imagem que vc postou, mais só aparece o nome da UserForm na barra, OK

Mais titio eu quero que apareça a imagem e o nome na barra? Então muita calma

É só juntar os códigos e mandar ver.

Bons estudos e espero ter ajudado

Um forte abraço aos amigos.

[Erikson]

Melo, tentei fazer o que vc passo mas apresentou problema nos códigos inseridos na form:

[Melo]

Melo, tentei fazer o que vc passo mas apresentou o seguinte problema nos códigos inseridos na form:

Caríssimo Uotson, Opa! . . . Erikson

Vamos a solução deste pequeno erro,

pois bem!... observando o código diagnostiquei que faltou o seguinte:

Private Sub UserForm_Activate()
Set mclsFormChanger = New CFormChanger
Set mclsFormChanger.Form = Me
cbTaskBar.Value = True
cbTaskBar.Value = False
End Sub

Mais esse complemento não gera o erro, o que será em?

Um minuto vou refazer os testes . . . .
.
.
.
Um minuto depois

Irmão meus testes funcionaram corretamente,
Em anexo a planilha em pleno funcionamento, baixe e faça os teste

Qualquer BO é só postar

Blz