[Resolvido]Ícone do meu sistema na barra de tarefas do Windows 10

Olá Pessoal.

A muito tempo uso a função abaixo para que o ícone do meu aplicativo apareça na barra de tarefas:

Private Function fncTítuloUsuário(usuário As String)
On Error Resume Next
Dim myIcon As String
myIcon = CurrentProject.Path & "\Imagens\sa.ico"
CurrentDb.Properties("AppTitle") = "Sistema S-Escola v.4 | Usuário Atual: " & UCase(fncNomeUsuario)
SetFormIcon Me.hWnd, myIcon
CurrentDb.Properties("AppIcon") = myIcon
Application.RefreshTitleBar
End Function

No entanto, ela não tem funcionado no windows 10. O que preciso fazer para que funcione tão bem como no Win 7?

grato

Ola;

A função "SetFormIcon" requer uma API 32bits.

O seu Office é 32 ou 64bits ?

Tem de colar aqui todo o código incluído as linhas da API e função.

Obrigado pela atenção.

meu office é de 32b.

Ok, então vai fazer o seguinte, porque o win10 é esquisito mesmo...

Vá a Configurações da Barra de Tarefas
Combinar os Botões da Barra de Tarefas

Altere para "Nunca"

Teste e retorne por favor.

JP, deu certo.

Mas, eu tenho uma aplicação que é instalada através de um instalador e o ideal seria que eu não precisasse fazer ou pedir que o cliente faça este processo.

O código que lhe mostrei acima é do frmLogin do mestre Avelino. Questionei-o em outro fórum sobre como resolver, mas ele não me deu resposta.

Veja esse tópico. Não consigo adaptar, talvez por não ter entendido.

redeaccess.com.br/viewtopic.php?f=19&t=206

Tem de ver essa parte, lá mesmo.

O assunto que o trouxe aqui por agora está resolvido.

Perfeito mestre JPaulo

O meu não funcionou no Win10 com um código que uso do caro Criquio
Mas com esta configuração funcionou.

Código:

Option Compare Database

Option Explicit
'Código disponível no forum maximomaccess pelo mestre criquio
Public strCaminho As String
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_GETICON = &H7F
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0
Private Const ICON_BIG = 1
Private Const IMAGE_BITMAP = 0
Private Const IMAGE_ICON = 1
Private Const IMAGE_CURSOR = 2
Private Const IMAGE_ENHMETAFILE = 3
Private Const LR_DEFAULTCOLOR = &H0
Private Const LR_MONOCHROME = &H1
Private Const LR_COLOR = &H2
Private Const LR_COPYRETURNORG = &H4
Private Const LR_COPYDELETEORG = &H8
Private Const LR_LOADFROMFILE = &H10
Private Const LR_LOADTRANSPARENT = &H20
Private Const LR_DEFAULTSIZE = &H40
Private Const LR_LOADMAP3DCOLORS = &H1000
Private Const LR_CREATEDIBHeader = &H2000
Private Const LR_COPYFROMRESOURCE = &H4000
Private Const LR_SHARED = &H8000
Function CurrentDbDir() As String
Dim strName As String
strName = Currentdb.Name
CurrentDbDir = Left(strName, Len(strName) - Len(Dir(strName)))
End Function
Function DefinirNomeAplicativo()
Dim intX As Integer
strCaminho = CurrentDbDir + "\Imagens\Icon.ico"
intX = AlterarPropriedade("AppTitle", dbText, "Título aqui")
intX = AlterarPropriedade("AppIcon", dbText, strCaminho)
RefreshTitleBar
End Function
Function AlterarPropriedade(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer
On Error Resume Next
Dim prp As Property, DB As DAO.Database
Const conPropNotFoundError = 3270
Set DB = Currentdb
On Error GoTo Change_Err
DB.Properties(strPropName) = varPropValue
AlterarPropriedade = True
Change_Bye:
Set DB = Nothing
Exit Function
Change_Err:
If Err = conPropNotFoundError Then '
Set prp = DB.CreateProperty(strPropName, varPropType, varPropValue)
DB.Properties.Append prp
Resume Next
Else
AlterarPropriedade = False
Resume Change_Bye
End If
End Function

No formulário principal, coloque no evento "Ao carregar":

Call DefinirNomeAplicativo