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

    [Resolvido]Copiar todos os dados do registo anterior para um novo registo

    avatar
    Luís Antunes
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 308
    Registrado : 05/04/2016

    [Resolvido]Copiar todos os dados do registo anterior para um novo registo Empty [Resolvido]Copiar todos os dados do registo anterior para um novo registo

    Mensagem  Luís Antunes em 31/10/2019, 18:01

    Este código abaixo duplicava todos os campos para um novo registo.
    Tentei utilizá-lo no novo projecto e deu erro na 3ª linha
    Estou a utilizar o Office 2007.

    Código:
      'DoCmd.GoToRecord , , acFirst
        DoCmd.GoToRecord , , acNewRec
        AutoFillNewRecord Me
    Exit_BtnOrcamento_Click:
        Exit Sub
    Err_BtnOrcamento_Click:
        MsgBox Err.Description
        Resume Exit_BtnOrcamento_Click

    Luís Antunes
    avatar
    Luís Antunes
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 308
    Registrado : 05/04/2016

    [Resolvido]Copiar todos os dados do registo anterior para um novo registo Empty Re: [Resolvido]Copiar todos os dados do registo anterior para um novo registo

    Mensagem  Luís Antunes em 4/11/2019, 17:42

    Esqueci-me do módulo

    Código:
    Option Compare Database
    Option Explicit

    Function AutoFillNewRecord(F As Form)
    ' Função obtida no artigo 136127 - ACC: Fill Record w/ Data
    ' from Prev. Record Automatically (7.0/97), da Microsoft
    ' Knowledge Base:
    ' http://support.microsoft.com/?id=136127
     
     'Modificado por JR - accessjr@bol.com.br
     
        Dim rs As Recordset, C As Control
        Dim FillFields As String, FillAllFields As Integer
       
        On Error Resume Next
       
        'Sai se não for um novo registro.
        'If Not F.NewRecord Then Exit Function
       
        'Vai para o último registro do recordset do formulário.
        Set rs = F.RecordsetClone
        rs.MoveLast
       
        'Sai se não puder mover para o último registro (sem registros).
        If Err <> 0 Then Exit Function
       
        'Obtém a lista de campos para o autopreenchimento.
        FillFields = ";" & F![txt212] & ";"

        ' Se não houver o campo com a lista, então mude
        ' o flag para TODOS. Todos os campos serão preenchidos.
        FillAllFields = Err <> 0
       
        F.Painting = False
       
        'Loop por cada campo do formulário.
        For Each C In F
            If C.ControlType = acTextBox Then
            'Preenche o campo se o flag for True Ou se o campo estiver
            ' na lista da variável FillFields.
                If FillAllFields Or InStr(FillFields, ";" & (C.Name) & ";") > 0 Then
      If C.Name <> "txt212" Then
          If C.Name = "txt212" Then
                C.Name = rs(C.ControlSource) + 1
          Else
                C = rs(C.ControlSource)
             
          End If
        End If
      End If
    End If

        Next
       
        F.Painting = True
        Set rs = Nothing
        Set C = Nothing
       
    End Function

    Luís Antunes
    avatar
    Luís Antunes
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 308
    Registrado : 05/04/2016

    [Resolvido]Copiar todos os dados do registo anterior para um novo registo Empty Re: [Resolvido]Copiar todos os dados do registo anterior para um novo registo

    Mensagem  Luís Antunes em 4/11/2019, 18:58

    Consegui pôr o código a funcionar vou enviar, parte, do projecto pede ser que sirva a alguém.

    Luís Antunes
    Anexos
    [Resolvido]Copiar todos os dados do registo anterior para um novo registo AttachmentCopiaTudo.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (64 Kb) Baixado 18 vez(es)

      Data/hora atual: 18/9/2020, 14:21