MACRO
Ola a todos
Estou precisando de uma grande ajuda, já procurei em vários Fórum, mas não encontrei nada que resolvesse a minha dúvida. Ocorre que fiz um sistema no excel muito simples, e tenho um formulário de cadastro de fornecedor com tres itens, código, fornecedor e cnpj, gostaria de quando for gravado um novo fornecedor ele me avisa (ESTE FORNECEDOR Jà EXISTE), e se for o caso deleta o duplicado.
Uso o Excel 2007
Obrigado a todos, e segue o código.
[ô]INICIA O FORMULÃRIO
Private Sub UserForm_Initialize()
novo = False
alterar = False
excluir = False
[ô]txtCodigo.Locked = True
Set wsFornecedor = ThisWorkbook.Worksheets([Ô]Empresa[Ô])
Call HabilitaBotoesAlteracao
Call carregaDados
Call DesabilitaControles
End Sub
[ô]FUNÇÃO CARREGA OS DADOS A PARTIR DA LINHA 2
Private Sub carregaDados()
indiceRegistro = 2
Call CarregaRegistro
End Sub
[ô]FUNÇÃO PARA CARREGAR TODOS OS REGISTROS
Private Sub CarregaRegistro()
[ô]carrega os dados do primeiro registro
With wsFornecedor
If Not IsEmpty(.Cells(indiceRegistro, colEmpresa)) Then
Me.txtCodigo.Text = .Cells(indiceRegistro, colCodigo).Value
Me.txtEmpresa.Text = .Cells(indiceRegistro, colEmpresa).Value
Me.txtCNPJ.Text = .Cells(indiceRegistro, colCNPJ).Value
End If
End With
Call AtualizaRegistroAtual
End Sub
[ô]FUNÇÃO PARA MOSTRAR QUANTOS REGISTROS TEM GRAVADOS
Private Sub AtualizaRegistroAtual()
lblRegistro.Caption = [Ô] Mostrando [Ô] & indiceRegistro - 1 & [Ô] de [Ô] & wsFornecedor.UsedRange.Rows.Count - 1 & [Ô] Registros Gravados [Ô]
[ô]lblMensagem.Caption = [Ô][Ô]
End Sub
[ô]FUNÇÃO PARA LIMPAR TODAS AS TEXT BOX
Private Sub LimpaControles()
Me.txtCodigo.Text = [Ô][Ô]
Me.txtEmpresa.Text = [Ô][Ô]
Me.txtCNPJ.Text = [Ô][Ô]
lblMensagem = [Ô][Ô]
End Sub
[ô]FUNÇÃO PARA HABILITAR OS CONTROLES E ALETRA AS CORES DAS TEXT BOX
Private Sub HabilitaControles()
Me.txtEmpresa.Locked = False
Me.txtCNPJ.Locked = False
[ô]altera a cor dos controles
Me.txtEmpresa.BackColor = corHabilitaTextBox
Me.txtCNPJ.BackColor = corHabilitaTextBox
End Sub
[ô]FUNÇÃO PARA DESABILITAR OS CONTROLES E ALETRA AS CORES DAS TEXT BOX
Private Sub DesabilitaControles()
Me.txtEmpresa.Locked = True
Me.txtCNPJ.Locked = True
[ô]altera a cor dos controles
Me.txtEmpresa.BackColor = corDesabilitaTextBox
Me.txtCNPJ.BackColor = corDesabilitaTextBox
End Sub
[ô]FUNÇÃO PARA HABILITAR OS BOTOÕES DE CONTROLE
Private Sub HabilitaBotoesAlteracao()
[ô]habilita os botões de alteração
cmdAlterar.Enabled = True
cmdExcluir.Enabled = True
cmdNovo.Enabled = True
cmdOk.Enabled = False
cmdCancelar.Enabled = False
cmdSair.Enabled = True
End Sub
[ô]FUNÇÃO PARA DESABILITAR OS BOTOÕES DE CONTROLE
Private Sub DesabilitaBotoesAlteracao()
[ô]desabilita os botões de alteração
cmdAlterar.Enabled = False
cmdExcluir.Enabled = False
cmdNovo.Enabled = False
cmdOk.Enabled = True
cmdCancelar.Enabled = True
cmdSair.Enabled = False
End Sub
[ô]FUNÇÃO PARA LIMPAR AS MENSAGENS
Sub limpaMensagem()
lblMensagem.Caption = [Ô][Ô]
End Sub
[ô]FORMATA A TEXT BOX PARA FORMATO CNPJ
Private Sub txtCNPJ_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
txtCNPJ.MaxLength = 18 [ô]07.454.325/0001-41
Select Case KeyAscii
Case 8 [ô]Aceita o BACK SPACE
Case 13: SendKeys [Ô]{TAB}[Ô] [ô]Emula o TAB
Case 48 To 57
If txtCNPJ.SelStart = 2 Then txtCNPJ.SelText = [Ô].[Ô]
If txtCNPJ.SelStart = 6 Then txtCNPJ.SelText = [Ô].[Ô]
If txtCNPJ.SelStart = 10 Then txtCNPJ.SelText = [Ô]/[Ô]
If txtCNPJ.SelStart = 15 Then txtCNPJ.SelText = [Ô]-[Ô]
Case Else: KeyAscii = 0 [ô]Ignora os outros caracteres
End Select
End Sub
[ô]COMANDO PARA SAIR DO SISTEMA
Private Sub cmdSair_Click()
[ô]MsgBox ([Ô][Ô])
[ô]If contador = 0 Then
MsgBox ([Ô]O Sistema Será Encerrado[Ô])
[ô]MsgBox [Ô]AO FINAL SALVE SUA PLANILHA ! [Ô], vbOKOnly, [Ô] AVISO [Ô]
[ô]MsgBox ([Ô]AO FINAL SALVE SUA PLANILHA ![Ô])
[ô]Applicmation.DisplayAlerts = False
Application.Quit
Plan1.Visible = xlSheetHidden
End Sub
[ô]FORÇA A PRIMEIRA LETRA MAIÚSCULA NO CAMPO EMPRESA
Private Sub txtEmpresa_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
txtEmpresa.Text = StrConv(txtEmpresa.Text, vbProperCase)
End Sub
Estou precisando de uma grande ajuda, já procurei em vários Fórum, mas não encontrei nada que resolvesse a minha dúvida. Ocorre que fiz um sistema no excel muito simples, e tenho um formulário de cadastro de fornecedor com tres itens, código, fornecedor e cnpj, gostaria de quando for gravado um novo fornecedor ele me avisa (ESTE FORNECEDOR Jà EXISTE), e se for o caso deleta o duplicado.
Uso o Excel 2007
Obrigado a todos, e segue o código.
[ô]INICIA O FORMULÃRIO
Private Sub UserForm_Initialize()
novo = False
alterar = False
excluir = False
[ô]txtCodigo.Locked = True
Set wsFornecedor = ThisWorkbook.Worksheets([Ô]Empresa[Ô])
Call HabilitaBotoesAlteracao
Call carregaDados
Call DesabilitaControles
End Sub
[ô]FUNÇÃO CARREGA OS DADOS A PARTIR DA LINHA 2
Private Sub carregaDados()
indiceRegistro = 2
Call CarregaRegistro
End Sub
[ô]FUNÇÃO PARA CARREGAR TODOS OS REGISTROS
Private Sub CarregaRegistro()
[ô]carrega os dados do primeiro registro
With wsFornecedor
If Not IsEmpty(.Cells(indiceRegistro, colEmpresa)) Then
Me.txtCodigo.Text = .Cells(indiceRegistro, colCodigo).Value
Me.txtEmpresa.Text = .Cells(indiceRegistro, colEmpresa).Value
Me.txtCNPJ.Text = .Cells(indiceRegistro, colCNPJ).Value
End If
End With
Call AtualizaRegistroAtual
End Sub
[ô]FUNÇÃO PARA MOSTRAR QUANTOS REGISTROS TEM GRAVADOS
Private Sub AtualizaRegistroAtual()
lblRegistro.Caption = [Ô] Mostrando [Ô] & indiceRegistro - 1 & [Ô] de [Ô] & wsFornecedor.UsedRange.Rows.Count - 1 & [Ô] Registros Gravados [Ô]
[ô]lblMensagem.Caption = [Ô][Ô]
End Sub
[ô]FUNÇÃO PARA LIMPAR TODAS AS TEXT BOX
Private Sub LimpaControles()
Me.txtCodigo.Text = [Ô][Ô]
Me.txtEmpresa.Text = [Ô][Ô]
Me.txtCNPJ.Text = [Ô][Ô]
lblMensagem = [Ô][Ô]
End Sub
[ô]FUNÇÃO PARA HABILITAR OS CONTROLES E ALETRA AS CORES DAS TEXT BOX
Private Sub HabilitaControles()
Me.txtEmpresa.Locked = False
Me.txtCNPJ.Locked = False
[ô]altera a cor dos controles
Me.txtEmpresa.BackColor = corHabilitaTextBox
Me.txtCNPJ.BackColor = corHabilitaTextBox
End Sub
[ô]FUNÇÃO PARA DESABILITAR OS CONTROLES E ALETRA AS CORES DAS TEXT BOX
Private Sub DesabilitaControles()
Me.txtEmpresa.Locked = True
Me.txtCNPJ.Locked = True
[ô]altera a cor dos controles
Me.txtEmpresa.BackColor = corDesabilitaTextBox
Me.txtCNPJ.BackColor = corDesabilitaTextBox
End Sub
[ô]FUNÇÃO PARA HABILITAR OS BOTOÕES DE CONTROLE
Private Sub HabilitaBotoesAlteracao()
[ô]habilita os botões de alteração
cmdAlterar.Enabled = True
cmdExcluir.Enabled = True
cmdNovo.Enabled = True
cmdOk.Enabled = False
cmdCancelar.Enabled = False
cmdSair.Enabled = True
End Sub
[ô]FUNÇÃO PARA DESABILITAR OS BOTOÕES DE CONTROLE
Private Sub DesabilitaBotoesAlteracao()
[ô]desabilita os botões de alteração
cmdAlterar.Enabled = False
cmdExcluir.Enabled = False
cmdNovo.Enabled = False
cmdOk.Enabled = True
cmdCancelar.Enabled = True
cmdSair.Enabled = False
End Sub
[ô]FUNÇÃO PARA LIMPAR AS MENSAGENS
Sub limpaMensagem()
lblMensagem.Caption = [Ô][Ô]
End Sub
[ô]FORMATA A TEXT BOX PARA FORMATO CNPJ
Private Sub txtCNPJ_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
txtCNPJ.MaxLength = 18 [ô]07.454.325/0001-41
Select Case KeyAscii
Case 8 [ô]Aceita o BACK SPACE
Case 13: SendKeys [Ô]{TAB}[Ô] [ô]Emula o TAB
Case 48 To 57
If txtCNPJ.SelStart = 2 Then txtCNPJ.SelText = [Ô].[Ô]
If txtCNPJ.SelStart = 6 Then txtCNPJ.SelText = [Ô].[Ô]
If txtCNPJ.SelStart = 10 Then txtCNPJ.SelText = [Ô]/[Ô]
If txtCNPJ.SelStart = 15 Then txtCNPJ.SelText = [Ô]-[Ô]
Case Else: KeyAscii = 0 [ô]Ignora os outros caracteres
End Select
End Sub
[ô]COMANDO PARA SAIR DO SISTEMA
Private Sub cmdSair_Click()
[ô]MsgBox ([Ô][Ô])
[ô]If contador = 0 Then
MsgBox ([Ô]O Sistema Será Encerrado[Ô])
[ô]MsgBox [Ô]AO FINAL SALVE SUA PLANILHA ! [Ô], vbOKOnly, [Ô] AVISO [Ô]
[ô]MsgBox ([Ô]AO FINAL SALVE SUA PLANILHA ![Ô])
[ô]Applicmation.DisplayAlerts = False
Application.Quit
Plan1.Visible = xlSheetHidden
End Sub
[ô]FORÇA A PRIMEIRA LETRA MAIÚSCULA NO CAMPO EMPRESA
Private Sub txtEmpresa_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
txtEmpresa.Text = StrConv(txtEmpresa.Text, vbProperCase)
End Sub
Olha, vou ser completamente sincero com você. é até possÃvel fazer o que você quer, mas desaconselhável. Porque? O seu sistema já está com uma complexidade mediana, tendo até mesmo a necessidade de consistência de dados. Isso não é mais tarefa para o Excel, mas sim para um banco de dados, onde você pode aplicar chaves primárias à s colunas e não ter que fazer loops gigantescos e demoradÃssimos para tarefas super simples e triviais para um banco de dados, mesmo dos menores. Então meu conselho é partir para uma plataforma mais adequada à s suas necessidades e abandonar o Excel enquanto seu sistema está pequeno.
Talves seja isso
Sub Exemplo()
Dim r1 As Long
Dim r2 As Long
[ô]Suponha que as variáveis abaixo sejam obtidas através de entradas de formulário por um usuário:
Dim sData As String
Dim sD As String
Dim sE As String
sData = [Ô]02/10/2011[Ô]
sD = [Ô]XXX[Ô]
sE = [Ô]-1/010[Ô]
r1 = LinhaDe(Columns([Ô]C[Ô]), sData, Columns([Ô]E[Ô]), sE)
r2 = LinhaDe(Columns([Ô]C[Ô]), sData, Columns([Ô]D[Ô]), sD)
If r1 = 0 And r2 = 0 Then
[ô]OK, registro único
Else
[ô]r1 ou r2 é o número da linha que apresenta problema:
If r1 > 0 Then MsgBox [Ô]A nova entrada conflita com a linha: [Ô] & r1
If r2 > 0 Then MsgBox [Ô]A nova entrada conflita com a linha: [Ô] & r2
End If
End Sub
Function LinhaDe(ParamArray args() As Variant) As Long
[ô]Função personalizada que retorna linha de intervalo combinado duplicado
[ô]Uso: LinhaDe(intervalo1, critério1, intervalo2, critério2, ...)
Dim s As String
Dim m As Long
Dim ws As Worksheet
Dim wb As Workbook
Dim rng As Range
s = [Ô]=MATCH(1,[Ô]
For m = LBound(args) To UBound(args)
If m Mod 2 = 0 Then
Set rng = args(m)
Set ws = rng.Parent
Set wb = ws.Parent
s = s & [Ô]([Ô] & [Ô][ô][[Ô] & wb.Name & [Ô]][Ô] & ws.Name & [Ô][ô]![Ô] & rng.Address & [Ô]=[Ô]
Else
s = s & [Ô][Ô][Ô][Ô] & args(m) & [Ô][Ô][Ô][Ô] & [Ô])*[Ô]
End If
Next m
s = Left(s, Len(s) - 1)
s = s & [Ô],0)[Ô]
[ô]Se o cálculo abaixo der erro, ou a sintaxe da expressão está incorreta ou
[ô]o intervalo combinado é único
On Error Resume Next
LinhaDe = Evaluate(s)
On Error GoTo 0
End Function
Sub Exemplo()
Dim r1 As Long
Dim r2 As Long
[ô]Suponha que as variáveis abaixo sejam obtidas através de entradas de formulário por um usuário:
Dim sData As String
Dim sD As String
Dim sE As String
sData = [Ô]02/10/2011[Ô]
sD = [Ô]XXX[Ô]
sE = [Ô]-1/010[Ô]
r1 = LinhaDe(Columns([Ô]C[Ô]), sData, Columns([Ô]E[Ô]), sE)
r2 = LinhaDe(Columns([Ô]C[Ô]), sData, Columns([Ô]D[Ô]), sD)
If r1 = 0 And r2 = 0 Then
[ô]OK, registro único
Else
[ô]r1 ou r2 é o número da linha que apresenta problema:
If r1 > 0 Then MsgBox [Ô]A nova entrada conflita com a linha: [Ô] & r1
If r2 > 0 Then MsgBox [Ô]A nova entrada conflita com a linha: [Ô] & r2
End If
End Sub
Function LinhaDe(ParamArray args() As Variant) As Long
[ô]Função personalizada que retorna linha de intervalo combinado duplicado
[ô]Uso: LinhaDe(intervalo1, critério1, intervalo2, critério2, ...)
Dim s As String
Dim m As Long
Dim ws As Worksheet
Dim wb As Workbook
Dim rng As Range
s = [Ô]=MATCH(1,[Ô]
For m = LBound(args) To UBound(args)
If m Mod 2 = 0 Then
Set rng = args(m)
Set ws = rng.Parent
Set wb = ws.Parent
s = s & [Ô]([Ô] & [Ô][ô][[Ô] & wb.Name & [Ô]][Ô] & ws.Name & [Ô][ô]![Ô] & rng.Address & [Ô]=[Ô]
Else
s = s & [Ô][Ô][Ô][Ô] & args(m) & [Ô][Ô][Ô][Ô] & [Ô])*[Ô]
End If
Next m
s = Left(s, Len(s) - 1)
s = s & [Ô],0)[Ô]
[ô]Se o cálculo abaixo der erro, ou a sintaxe da expressão está incorreta ou
[ô]o intervalo combinado é único
On Error Resume Next
LinhaDe = Evaluate(s)
On Error GoTo 0
End Function
Citação::
Olha, vou ser completamente sincero com você. é até possÃvel fazer o que você quer, mas desaconselhável. Porque? O seu sistema já está com uma complexidade mediana, tendo até mesmo a necessidade de consistência de dados. Isso não é mais tarefa para o Excel, mas sim para um banco de dados, onde você pode aplicar chaves primárias à s colunas e não ter que fazer loops gigantescos e demoradÃssimos para tarefas super simples e triviais para um banco de dados, mesmo dos menores. Então meu conselho é partir para uma plataforma mais adequada à s suas necessidades e abandonar o Excel enquanto seu sistema está pequeno.
Ok, obrigado pela resposta, eu faço sistemas em VB, Java e VBNET, usando banco de dados, mas tem uma pessoa com quem eu trabalho, que ele quer em Excel.
CRCJ, tenho exemplos de como manipular banco de dados direto na planilha, sugiro para esse caso usar uma SQL. Como foi dito acima, seria melhor usar um banco de dados pode ser o Access. Tenho aplicativos em Excel VBA que funciona muito bem com o Access, da trabalho em codificar mas torna a planilha bem mais leve. Abaixo um link onde vc pode encontrar exemplos e respostas para questões relativas ao Excel VBA avançado.
http://www.tudosobrexcel.com/
http://www.tudosobrexcel.com/
IRENKO, boa tarde, primeiramente obrigado pelo seu retorno, como mencionei acima, faço sistemas em VB, VBNET e Java usando bancos de dados, mas a pessoa quer tudo em excel, eu já usei no começo planilhas, mas depois fui me aprimorando e larguei o excel a muitos anos. Voltar agora é retroceder, mas a pessoa só conhece o excel, ele quer abrir as planilhas e ver como ficou depois de cadastrar vários itens.
Bem, ok então. O que você vai fazer é um loop percorrendo toda a planilha comparando os valores das células(da coluna que você quer como chave primária, seja código ou CNPJ) e caso o valor exista, exiba a mensagem e sobreponha o conteúdo.
KERPLUNK, bom dia.
Poderia por favor postar um exemplo de como eu faria isso.
Segue anexo o arquivo:
Login: wmendes
Senha: 872487
Poderia por favor postar um exemplo de como eu faria isso.
Segue anexo o arquivo:
Login: wmendes
Senha: 872487
Na sub [Ô]SalvaRegistro[Ô], inclua algo como:
Dim i As Integer
Dim sair As Boolean
sair = False
i = 1
Do While sair = False
With wsCadastroClientes
If .Cells(i, 0).Value = [Ô][Ô] Then sair = True
If .Cells(i, 0).Value = id Then
MsgBox [Ô]Já tem[Ô]
End If
End With
i = i + 1
Loop
Também tem como usar o próprio Excel como banco de dados e trabalhar com SQL, via ADO (só agora reparei como essas duas palavras ficam engraçadas juntas haha)
Fiz isso numa empresa que não aceitava eu usar um Visual Studio nem um banco de dados da vida.
Só que você precisa de dois arquivos Excel: um servindo só como banco de dados e o outro como se fosse seu aplicativo. Por que? Eu tentei fazer tudo no mesmo arquivo uma vez. Funciona? Funciona. Mas fica extremamente lento, você não tem ideia.
Mas se for uma base pequena, sem relacionamentos... Vai percorrendo no loop mesmo, sem erro.
Fiz isso numa empresa que não aceitava eu usar um Visual Studio nem um banco de dados da vida.
Só que você precisa de dois arquivos Excel: um servindo só como banco de dados e o outro como se fosse seu aplicativo. Por que? Eu tentei fazer tudo no mesmo arquivo uma vez. Funciona? Funciona. Mas fica extremamente lento, você não tem ideia.
Mas se for uma base pequena, sem relacionamentos... Vai percorrendo no loop mesmo, sem erro.
KERPLUNK, bom dia.
Deu erro de compilação, segue anexo.
Deu erro de compilação, segue anexo.
Tópico encerrado , respostas não são mais permitidas