[Resolvido]Trocar ícone do meu programa

OLá, boa tarde , por eu ser novo nessa linguagem eu pesquiso aqui mas eu acho que não estou sabendo pesquisar direito . alguem pode me ajudar como trocar ícone

Boa Noite Crisostomo!!!

Achei esses tópicos aqui no fórum, espero que ajude, abraços, fica na Paz do Senhor Jesus!!!

https://www.maximoaccess.com/t29754-resolvidotirando-o-icone-desenho-do-access?highlight=icone

https://www.maximoaccess.com/t26846-resolvidowindows-10-nao-exibe-o-icone-personalizado-do-bd?highlight=icone

https://www.maximoaccess.com/t1308-resolvidotem-como-trocar-o-icone-padrao-em-bnaco-de-dados-em-access?highlight=icone

galera estou fazendo outro sistema , mas não consigo trocar o ícone de barras de tarrafas.
Ja fiz muitos modulos e não consogo, o ultimo que fiz foi um topico que achei aqui.

Código:

[b]Option Compare Database

Option Explicit
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 + "C:\Users\g\Desktop\Projetos ADV\projeto de sistema diario EBD\icones\favicon.ico"
intX = AlterarPropriedade("AppTitle", dbText, "DiárioEBd")
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

Private Sub Form_Load()
Call DefinirNomeAplicativo
End Sub[/b]

Não consigo, aonde eu erro  aqui?

Olá Gilliard, nem tentou uma pesquisa no fórum!

Não falta exemplos no forum, veja como fazer uma "Busca":
https://www.maximoaccess.com/t1115-busca-no-forum-search

Veja:
https://www.maximoaccess.com/t30869-resolvidoicon-da-aplicacao

Aproveito para alertar que tem vários tópicos abertos e que deve dar continuidade e retorno aos colegas que tentam ajudar.
Verifique a situação.

Abraço e bons estudos com o MaximoAccess.

eu usei ahteixeira foi aqui  no fórum que achei esse código , e que não consigo entender porque não está funcionando.
Ja fiz , colei os módulos que está no link ja alterei o caminho e nada.


será que não funciona porque não está no executável?

Olá,

E quanto à Verifique a situação

Relativo à questão estou a preparar um exemplo, apesar da situação já ter sido relatada e resolvida para essa situação nas versões superiores do Windows 7.

Abraço

Galera desculpa , mas eu ja tentei muitas veses ja mudei  codigo e não consigo trocar o  ícone

pessoal ,  qual  é o  meu problema aqui  me ajuda aqui ,.

estou tentando  troca icone da barra de tarefas um monte de veses e não consigo.

Public Function SetappIcon()
Dim IconPath As String
Dim AppIconPrp As Property
Dim db As Database
On Error Resume Next
IconPath = "C:\Users\g\Desktop\Projetos ADV\projeto de sistema diario EBD\icones\faviconebd.ico"
Set db = CurrentDb
Set AppIconPrp = db.CreateProperty()
AppIconPrp.Name = "AppIcon"
AppIconPrp.Type = dbText
AppIconPrp.Value = IconPath
db.Properties.Append AppIconPrp
db.Properties("AppIcon") = IconPath
Application.RefreshTitleBar
Set db = Nothing
End Function
Private Sub Form_open()
Call SetappIcon '' nome do módulo e da sub

End Sub


preciso mudar isso.

Olá Gilliard,

Teste exemplo do tópico abaixo:
https://www.maximoaccess.com/t33894-icon-e-titulo-da-aplicacao-e-criar-atalho-no-ambiente-de-trabalho

Ficamos aguardar o retorno.

Abraço

Bom dia!

Eu esqueceria o código e faria com um atalho. Crie um atalho para a sua aplicação e nas propriedades do atalho você coloca a imagem que quiser.

Faço desta forma sempre.

Tente e nos informe se deu certo.

Abraços.

Julio Lustosa
 colega , isso so muda o ícone da tela , da barra de tarefas não muda , porque a base dele é access.
como  consegue mudar o ícone na barra de tarefas?

Depois de tantos erros meus com ajuda de vocês , problema resolvido, mas quero tirar uma duvida com nosso  amigo ahteixeira

Olá a todos,

Gilliard, se está relacionado com o tópico, pode colocar aqui a questão.
Também deve dar o retorno de como resolveu, pois assim ajuda outros membros com a mesma dúvida, evitando abertura de tópicos duplicados.

Abraço

eu peguei o código  do irmão teixeira  e implantei no meu programa , por isso tive que criar o botão no início do programa, pois não tive outro jeito. agora só queria que ele desaparecesse após 1 click. farei um setup do sistema e ao acabar a instalação que farei ele abrira para criar atalho.
Pois estudei esse código e não conseguí entender como que ele sabe de qual programa ele vai fazer atalho

Olá Gillard,

O mais simples era sempre que abre o seu projeto (no primeiro form que apresenta) chamar o codigo que cria o Atalho.
Assim tinha a certeza que tinha sempre o Atalho, e se copiar a base de dados para outro computador vai criar (mesmo que já exista)

Respondendo à questão pode colocar o botão cmdCriarAtalho na propriedade Visivel como Não (para ficar por defeito oculto)

Cole o código abaixo:

Código:

Private Sub Form_Open(Cancel As Integer)
    If Len(Dir(Environ("USERPROFILE") & "\Desktop\NomeDoAtalho.lnk") & "") <> 0 then
        Me.cmdCriarAtalho.Visible = true
    End If
End Sub


Assim ao abrir se não existir o Atalho vai mostrar o botão.
Não se esqueça de ajustar o nome do atalho, mantendo a extensão LNK

Abraço

meu amigo , voltei  nesse tópico,  porque o office 2010 faz o  atalho , mais não troca o  icone da barra de tarefa
nesse codigo
pode me ajudar?

Código:

Private Sub Comando21_Click()
Dim oWSH As Object, oAtalho As Object
    Dim sCaminhoDesktop, sAtalho, sCaminhoBD As String
   sCaminhoBD = Application.CurrentProject.Path & "\" & Application.CurrentProject.Name   'pode-se alterar por caminhoCompleto\nomeBaseDados.ext
  
    Set oWSH = CreateObject("WScript.Shell")
   sCaminhoDesktop = oWSH.SpecialFolders("Desktop")
   sAtalho = sCaminhoDesktop & "\Alarme do Consultório.lnk"
    
    Set oAtalho = oWSH.CreateShortcut(sAtalho)
       With oAtalho
         .TargetPath = Chr(34) & SysCmd(9) & "MSACCESS.EXE" & Chr(34)
         .Arguments = Chr(34) & sCaminhoBD & Chr(34)
         .Description = "Agenda de compromisso"
         .WorkingDirectory = Application.CurrentProject.Path
          .IconLocation = Application.CurrentProject.Path & "\" & "iconeAlrme.ico"   'pode-se alterar por caminhoCompleto\nomeIcon.ico
          .Save
       End With
    
    MsgBox "Atalho criado no Ambiente de Trabalho (Desktop) com sucesso.", vbInformation, ""
    DoCmd.Quit

Tópicos fundidos.

Crysostomo, conseguiu resolver sua questão?

Bom dia meu nobre, sim , resolvido