MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access


2 participantes

    Cria atalho do projeto no Desktop do usuário atual

    Marcelo David
    Marcelo David
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3857
    Registrado : 21/04/2011

    Cria atalho do projeto no Desktop do usuário atual Empty Cria atalho do projeto no Desktop do usuário atual

    Mensagem  Marcelo David 5/8/2020, 15:05

    Este código (subCriaAtalho) cria um atalho do aplicativo na área de trabalho (desktop) do usuário.

    Poderá ser chamada na abertura do formulário inicial ou na macro autoexec
    (ou onde julgar necessário).

    Se quiser definir um ícone personalizado para o atalho, basta por no diretório raiz da
    aplicação um ícone com nome icon do tipo .ico.

    Caso não informe nenhum ícone, o atalho terá o ícone do Access.

    A subCriaAtalho tem um parâmetro opcional que é a descrição do atalho, ou seja,
    ao passar o mouse sobre o atalho, será exibido a descrição informada. Se não escrever
    nada na descrição, será mostrado apenas o caminho do aplicativo.

    Eis o código abaixo e um exemplo em anexo.
    Código:
    Public Sub subCriaAtalho(Optional strDescricao As String)
    'Autor: Marcelo David
    'Data: 04/08/2020
    'Propósito: criar ícone do aplicativo na área de trabalho do usuário ao executar o programa
    Dim wsc As Object
    Dim lnk
    Dim strPathDesktop As String, strNomeApp As String

    On Error GoTo TrataErro

        'Instancio o Windows Scripting Host
        Set wsc = CreateObject("wscript.shell")
        
        'Obtendo o path do desktop do usuário atual
        strPathDesktop = wsc.SpecialFolders("Desktop")
        
        'Extraindo o nome do aplicativo sem a extenção
        strNomeApp = Mid(CurrentProject.Name, 1, InStr(CurrentProject.Name, ".") - 1)
        
        'Instanciando um objeto do tipo atalho (lnk) e já definindo o desktop do usuário atual
        Set lnk = wsc.CreateShortcut(strPathDesktop & "\" & strNomeApp & ".lnk")
        
        'Verificando se já existe atalho e caso sim, apaga para criar o novo
        If Dir(strPathDesktop & "\" & strNomeApp & ".lnk") <> "" Then
            Kill strPathDesktop & "\" & strNomeApp & ".lnk"
        End If
        
        'Difinindo o aplicativo a ser executado ao clicar no link
        lnk.TargetPath = CurrentProject.FullName
        
        'Definindo a propriedade de "Iniciar em" do atalho (diretório de trabalho)
        lnk.WorkingDirectory = CurrentProject.Path
        
        'Caso tenha definido uma descrição (dica ao passar o mouse sobre o atalho)
        lnk.Description = strDescricao
        
        'Verifico se há o ícone do atalho para assim definir
        'Caso não haja ícone, o ícone do Access que será definido por padrão
        If Dir(CurrentProject.Path & "\icon.ico") <> "" Then
            lnk.IconLocation = CurrentProject.Path & "\icon.ico ,0"
        Else
            lnk.IconLocation = SysCmd(acSysCmdAccessDir) & "MSACCESS.EXE, 0"
        End If
        'Salvando o link
        lnk.Save
        
        'Apagando da memória o objeto Windows Scripting Host e o link
        Set lnk = Nothing 'Nem precisava apagar esse, já que é filho de wsc, mas para manter o bom hábito de apagar variávais de objetos
        Set wsc = Nothing
        
    Exit Sub
        
    TrataErro:
        MsgBox Err.Description, vbExclamation, "Erro " & Err.Number & " ao criar atalho"
    End Sub

    Espero que lhes seja útil.
    Anexos
    Cria atalho do projeto no Desktop do usuário atual AttachmentCriaAtalho.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (29 Kb) Baixado 117 vez(es)


    .................................................................................
    Aprenda como criar formulário desacoplado.
    Conheça meu canal no Youtube e se inscreva.
    Cria atalho do projeto no Desktop do usuário atual Marcel11

    pcnet, Driver11 e Anslu gostam desta mensagem

    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7914
    Registrado : 15/03/2013

    Cria atalho do projeto no Desktop do usuário atual Empty Re: Cria atalho do projeto no Desktop do usuário atual

    Mensagem  Alvaro Teixeira 5/8/2020, 16:48

    Olá Marcelo David,

    Parabéns! Está excelentemente comentado todo o código.

    Obrigado pela partilha.

    Abraço

    Marcelo David e Anslu gostam desta mensagem

    Marcelo David
    Marcelo David
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3857
    Registrado : 21/04/2011

    Cria atalho do projeto no Desktop do usuário atual Empty Re: Cria atalho do projeto no Desktop do usuário atual

    Mensagem  Marcelo David 6/8/2020, 13:57

    Obrigado Teixeira Wink


    .................................................................................
    Aprenda como criar formulário desacoplado.
    Conheça meu canal no Youtube e se inscreva.
    Cria atalho do projeto no Desktop do usuário atual Marcel11

    Conteúdo patrocinado


    Cria atalho do projeto no Desktop do usuário atual Empty Re: Cria atalho do projeto no Desktop do usuário atual

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 28/3/2024, 09:55