- 11 Jan 2020 às 13:10
#51599
Bom dia, amiguinhos. Hoje tenho mais uma dúvida para tirar com vocês. Eu criei uma MACRO de cadastro de erro, porém, estou com problemas na parte de data. A MACRO deveria "GRAVA" os dados e coloca automaticamente o dia que as informações foram inseridas. Até aí ela faz, mas, com um problema. A MACRO altera as data anteriores para atual.
EX.: Coloquei uma informação dia 10/01/2020, se eu coloca uma nova hoje 11/01/2020 ele grava a nova data, e também altera do outro registro do dia anterior.
EX.: Coloquei uma informação dia 10/01/2020, se eu coloca uma nova hoje 11/01/2020 ele grava a nova data, e também altera do outro registro do dia anterior.
Código: Selecionar todos
Private Sub Gravar_Click()
'Ativar a primeira planilha
ThisWorkbook.Worksheets("Database").Activate
'Selecionar a célula A4
Range("A4").Select
'Procurar a primeira célula vazia
Do
If Not (IsEmpty(ActiveCell)) Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
'Não gravar com os espaçoes em branco
If TexBox1.Text = "" Or ComboBox1.Text = "" Or ComboBox2.Text = "" Or ComboBox3.Text = "" Or ComboBox4.Text = "" Or TextBox2.Text = "" Then
MsgBox "PREENCHIMENTO OBRIGATÓRIO DE TODOS OS CAMPOS", vbExclamation, "AVISO"
Exit Sub
End If
'Carregar os dados digitados nas caixas de texto para a planilha
ActiveCell.Copy
ActiveCell.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.FormulaR1C1 = "=WEEKNUM(RC[7])"
x = Range("F1").Value
ActiveCell.Offset(0, 1).Value = TexBox1.Value
ActiveCell.Offset(0, 2).Value = ComboBox1.Value
ActiveCell.Offset(0, 3).Value = ComboBox2.Value
ActiveCell.Offset(0, 4).Value = ComboBox3.Value
ActiveCell.Offset(0, 5).Value = x
ActiveCell.Offset(0, 6).Value = ComboBox4.Value
ActiveCell.Offset(0, 7).Value = "=TODAY()"
ActiveCell.Copy
ActiveCell.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 8).Value = TextBox2.Value
MsgBox "Dados registrados com sucesso!!!"
ActiveWorkbook.Save
'Limpar as caixas de texto
TexBox1.Value = Empty
ComboBox1.Value = Empty
ComboBox2.Value = Empty
ComboBox3.Value = Empty
ComboBox4.Value = Empty
TextBox2.Value = Empty
'Colocar o foco na primeira caixa de texto
TexBox1.SetFocus
End Sub
Private Sub Limpar_Click()
'Limpar as caixas de texto
TexBox1.Value = Empty
ComboBox1.Value = Empty
ComboBox2.Value = Empty
ComboBox3.Value = Empty
ComboBox4.Value = Empty
TextBox2.Value = Empty
'Colocar o foco na primeira caixa de texto
TexBox1.SetFocus
End Sub
Private Sub CommandButton4_Click()
Unload Me
UserForm2.Show
End Sub
Private Sub MultiPage1_Change()
End Sub
Private Sub Sair_Click()
ThisWorkbook.Close (True)
'ThisWorkbook.Close False
'ActiveWorkbook.Save
'Application.Quit
End Sub
'Bloquear (X) para fechar a planilha por formulario (Userform)
Private Sub UserForm_QueryClose _
(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
MsgBox "Preencha os dados e clique em Gravar, ou aperte em Sair", vbCritical, "AVISO"
Cancel = True
End If
End Sub