Access inicio | | | | | |
Olá,
Seja Bem Vindo ao Blog.

Conecte-se ou registre-se e utilize gratuitamente este equipamento, temos exemplos referente a criação de banco de dados e desenvolvimento de softwares e programas utilizando o Microsoft Access.


Administração do Blog AccessDoProgramador.

VBA, Código para Criar Item e Sub-Item por Registro

Ver o tópico anterior Ver o tópico seguinte Ir em baixo

19112012

Mensagem 

VBA, Código para Criar Item e Sub-Item por Registro






Olá amigos,

A partir de um exemplo de manipulação de Strings, estou deixando um código para criar itens e sub-itens em uma tabela, por exemplo:

ID
1000
1001
1002
1002.1
1002.2
1002.3
1003
1004
1004.1
1004.2
....

No programa você tem a opção de adicionar um registro ou alterá-lo. No primeiro caso, você acrescenta um código com valor inteiro(item). No segundo caso, você adiciona um sub-item. Vamos estudar o código que adiciona o sub-item:

Private Sub cmdAlterar_Click()
On Error Resume Next
Dim strRegistro As String
Dim strFatura As Currency
Dim strNome As String
Dim strStatus As String
Dim n As Integer
Dim sDesconto As Double
Dim nFaturamento As Currency


If IdRegistro = Format(IdRegistro, "0000.0") Then
'Se o formato do código for com ponto(ou sub-item) acrescenta o próximo sub-item
n = Mid(Format(DLast(IdRegistro, "tblPai"), "0000.0"), 6, 6) 'Pega o último dígito do último código
n = n + 1

strRegistro = Format(DLast(Mid(IdRegistro, 1, 4) & "." & n, "tblPai"), "0000.0") 'Formata o código e acrescenta uma unidade ao valor depois do ponto
strRegistro = Replace(strRegistro, ",", ".") 'Corrige e reformata o código
strNome = Cliente

'Parte do código aqui é para atender um colega para fazer um determinado cálculo
'*****************************************************************************
sDesconto = InputBox("Digite o valor do desconto?", "Valor Inteiro")
nFaturamento = InputBox("Digite o valor do faturamento inicial:", "Faturamento")
strFatura = nFaturamento - (nFaturamento * sDesconto / 100)
strStatus = Status
DoCmd.SetWarnings False
strRegistro = "INSERT INTO tblPai(IdRegistro,Cliente,Faturamento,Desconto, Status) VALUES('" & strRegistro & "', '" & strNome & "', '" & strFatura & "', '" & sDesconto & "','" & strStatus & "')"
DoCmd.RunSQL strRegistro
DoCmd.RunCommand acCmdRefresh
DoCmd.SetWarnings True
MsgBox "Dados Alterados com sucesso !!!", vbExclamation, "Cadastro de Propostas"

Else
'Caso o contrário. Se o formato for de um item, cria um sub-item e renumera a contagem
n = Mid(Format(DLast(IdRegistro, "tblPai"), "0000.0"), 6, 6) 'Pega o último dígito do último código
n = n + 1
strRegistro = Format(DLast(Mid(IdRegistro, 1, 4) & "." & n, "tblPai"), "0000.0")
'Formata o código e acrescenta uma unidade ao valor depois do ponto
strRegistro = Replace(strRegistro, ",", ".")
strNome = Cliente


'Parte do código aqui é para atender um colega para fazer um determinado cálculo
'*****************************************************************************
sDesconto = InputBox("Digite o valor do desconto?", "Valor Inteiro")
nFaturamento = InputBox("Digite o valor do faturamento inicial:", "Faturamento")
strFatura = nFaturamento - (nFaturamento * sDesconto / 100)
strStatus = Status
DoCmd.SetWarnings False
strRegistro = "INSERT INTO tblPai(IdRegistro,Cliente,Faturamento,Desconto,Status) VALUES('" & strRegistro & "', '" & strNome & "', '" & strFatura & "', '" & sDesconto & "','" & strStatus & "')"
DoCmd.RunSQL strRegistro
DoCmd.RunCommand acCmdRefresh
DoCmd.SetWarnings True
MsgBox "Dados Alterados com sucesso !!!", vbExclamation, "Cadastro de Propostas"
End If
DoCmd.RunCommand acCmdRefresh

End Sub


OBS: Coloque uma listbox (Caixa de Listagem) que faça pesquisa do registro pelo item selecionado. No evento Click da listbox coloque:

me.Lista23.Requery 'Pode ter outro nome de lista com outro número

A cada avanço do registro deixe o último item selecionado. Clique duas vezes no item selecionado para atualizar o registro com os novos dados com o seguinte código:

Private Sub Lista26_DblClick(Cancel As Integer)
DoCmd.Close acForm, "Cadastro de Propostas", acSaveYes
DoCmd.OpenForm "Cadastro de Propostas", acNormal
DoCmd.RunCommand acCmdRecordsGoToLast
End Sub


Baixar o exemplo:
Download

#Se você gostou da dica, curta minha página no Facebook, comente e compartilhe com seus amigos:

https://www.facebook.com/EduardoMachado
avatar
good guy
Facilitador
Facilitador

Brasil


http://www.goodguyaccessvba.com.br

Voltar ao Topo Ir em baixo

- Tópicos similares
Compartilhar este artigo em: BookmarksDiggRedditDel.icio.usGoogleLiveSlashdotNetscapeTechnoratiStumbleUponNewsvineFurlYahoo!Smarking

 
Permissão deste fórum:
Você não pode responder aos tópicos neste fórum