Olá a todos, partilho exemplo para:
A) Criar ou alterar Icon e Título da aplicação.
B) Criar atalho no Ambiente de Trabalho (DeskTop)
Abraço
A) Criar ou alterar Icon e Título da aplicação.
- Código:
Private Sub cmdIconTitulo_Click()
'AHTEIXEIRA 2018 para MaximoAccess
On Error GoTo Trata_Erro
Dim iTrataErr As Integer
Dim NomeProp, ValorProp As String
'guarda valor tratamento de erros e altera para modo classe
iTrataErr = Application.GetOption("Error Trapping")
Application.SetOption "Error Trapping", 1
'nome do projeto (base de dados)
NomeProp = "AppTitle"
ValorProp = "A minha APP..." '*** alterar nesta linha ***
CurrentDb.Properties(NomeProp) = ValorProp
'Icon do projeto (base de dados)
NomeProp = "AppIcon"
ValorProp = CurrentProject.Path & "\icon.ico" '*** alterar nesta linha ***
CurrentDb.Properties(NomeProp) = ValorProp
Application.RefreshTitleBar
MsgBox "Alteração concluída.", vbInformation, ""
Sair_Sub:
'repoe valor tratamento erros
Application.SetOption "Error Trapping", iTrataErr
Exit Sub
Trata_Erro:
If Err.Number = 3270 Then 'caso nao exista
Dim AppPrp As Property
Dim db As Database
Set db = CurrentDb
Set AppPrp = db.CreateProperty()
AppPrp.Name = NomeProp
AppPrp.Type = dbText
AppPrp.Value = ValorProp
db.Properties.Append AppPrp
db.Properties(NomeProp) = ValorProp
Set AppPrp = Nothing
Set db = Nothing
Resume Next
Else
MsgBox "Erro # " & Err.Number & vbCrLf & vbLf & Err.Description
Resume Sair_Sub
End If
End Sub
B) Criar atalho no Ambiente de Trabalho (DeskTop)
- Código:
Private Sub cmdCriarAtalho_Click()
'AHTEIXEIRA 2018 para MaximoAccess
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 & "\MinhaAPP.lnk"
Set oAtalho = oWSH.CreateShortcut(sAtalho)
With oAtalho
.TargetPath = Chr(34) & SysCmd(9) & "MSACCESS.EXE" & Chr(34)
.Arguments = Chr(34) & sCaminhoBD & Chr(34)
.Description = "Descrição da minha APP"
.WorkingDirectory = Application.CurrentProject.Path
.IconLocation = Application.CurrentProject.Path & "\" & "icon.ico" 'pode-se alterar por caminhoCompleto\nomeIcon.ico
.Save
End With
MsgBox "Atalho criado no Ambiente de Trabalho (Desktop), verifique.", vbInformation, ""
DoCmd.Quit
End Sub
Abraço
- Anexos
Icon_e_Criar_atalho_desktop.zip
- Você não tem permissão para fazer download dos arquivos anexados.
- (28 Kb) Baixado 459 vez(es)
Última edição por ahteixeira em 31/7/2018, 09:27, editado 1 vez(es)