MaximoAccess

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

Obrigado

Administração do MaximoAccess

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

    Função RepararCompactar por botão deixa de funcionar

    avatar
    Ivan Carlo
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 29
    Registrado : 13/06/2015

    Função RepararCompactar por botão deixa de funcionar Empty Função RepararCompactar por botão deixa de funcionar

    Mensagem  Ivan Carlo em 25/6/2020, 18:03

    Boa tarde Amigos e Mestres.
    Eu uso uma função sugerida aqui neste forum que só funciona com uma condição.

    A função é colocada em um botão para compactar e Reparar o BD quando uma tabela tem seus registros deletados.
    Isso é preciso para que a contagem dos numeros do registros à partir do "1" seja iniciada pois trata-se de uma numeração Automática.

    A função é:
    Código:
    Public Function RepararCompactar()
    On Error Resume Next
    CurrentDb.Execute "DELETE * FROM Produtos WHERE Misto=True And Fixo=False"

    Dim P As String
    P = Access.DBEngine.IniPath
    If P = "Software\Microsoft\Office\16.0\Access\Access Connectivity Engine" Then
        'MsgBox "Office 2016"
        SendKeys "%(Tm)", False
    ElseIf P = "Software\Microsoft\Office\15.0\Access\Access Connectivity Engine" Then
        'MsgBox "Office 2013"
        SendKeys "%(Tm)", False
    ElseIf P = "Software\Microsoft\Office\14.0\Access\Access Connectivity Engine" Then
        'MsgBox "Office 2010"
        SendKeys "%(Tc)", False
    ElseIf P = "Software\Microsoft\Office\12.0\Access\Access Connectivity Engine" Then
        'MsgBox "Office 2007"
        SendKeys "%(AgO)", False
    Else
        MsgBox "Adicione este caminho no código " & P
    End If
    End Function

    Ésta função funciona bem, mas se eu usar uma Macro Autoexec para esconder a Barra de opções do Office com a função:
    Código:
    Public Function fncDesabilitarRibbon()
       DoCmd.ShowToolbar "ribbon", acToolbarNo
    End Function

    A função RepararCompactar, pára de funcionar. Ela só age deletando os registros da tabela, mas não repara e compacta o BD.
    Alguém sabe uma solução?
    Obrigado desde já.
    Meu Office: Microsoft Office Profissional 2016 Plus
    Windows: Windows 10 64Bits


    Última edição por Ivan Carlo em 25/6/2020, 18:07, editado 1 vez(es) (Razão : Adição de informações sobre o meu Sistema)
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2137
    Registrado : 22/11/2016

    Função RepararCompactar por botão deixa de funcionar Empty Re: Função RepararCompactar por botão deixa de funcionar

    Mensagem  DamascenoJr. em 26/6/2020, 01:50

    Public Function RepararCompactar()
    On Error Resume Next
    CurrentDb.Execute "DELETE * FROM Produtos WHERE Misto=True And Fixo=False"
    DoCmd.ShowToolbar "ribbon", acToolbarYes
    Dim P As String
    P = Access.DBEngine.IniPath
    If P = "Software\Microsoft\Office\16.0\Access\Access Connectivity Engine" Then
       'MsgBox "Office 2016"
       SendKeys "%(Tm)", False
    ElseIf P = "Software\Microsoft\Office\15.0\Access\Access Connectivity Engine" Then
       'MsgBox "Office 2013"
       SendKeys "%(Tm)", False
    ElseIf P = "Software\Microsoft\Office\14.0\Access\Access Connectivity Engine" Then
       'MsgBox "Office 2010"
       SendKeys "%(Tc)", False
    ElseIf P = "Software\Microsoft\Office\12.0\Access\Access Connectivity Engine" Then
       'MsgBox "Office 2007"
       SendKeys "%(AgO)", False
    Else
       MsgBox "Adicione este caminho no código " & P
    End If
    End Function


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.
    avatar
    Ivan Carlo
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 29
    Registrado : 13/06/2015

    Função RepararCompactar por botão deixa de funcionar Empty Re: Função RepararCompactar por botão deixa de funcionar

    Mensagem  Ivan Carlo em 26/6/2020, 04:49

    Boa Noite Amigo Damasceno.
    Crying or Very sad Não deu certo.
    Continua não reparando.
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2137
    Registrado : 22/11/2016

    Função RepararCompactar por botão deixa de funcionar Empty Re: Função RepararCompactar por botão deixa de funcionar

    Mensagem  DamascenoJr. em 26/6/2020, 05:06

    Aqui resolveu. Aguardemos mais retornos.


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.

      Data/hora atual: 13/8/2020, 15:02