Boa tarde prezados
Eu fiz um formulário para alimentar uma tabela que será a base de dados. Eu vi na internet a fórmula para a macro sempre selecionar a ultima linha para inserir as proximas informações, seria esse o código:
linha = Sheets(“BASE”).Cells(Rows.Count, “E”).End(xlUp).Offset(1, 0).Row Sheet3.Cells(linha, 5).Value = Me.txtData.Value Sheet3.Cells(linha, 6).Value = Me.txtHorario.Value Sheet3.Cells(linha, 7).Value = Me.txtNome.Value Sheet3.Cells(linha, 8).Value = Me.txtRamal.Value Sheet3.Cells(linha, 9).Value = Me.txtAssunto.Value
Mas o formulário não preenche a tabela que já existe na planilha. Ele pega a primeira célula que não possui informações e seleciona ela. Eu gostaria que ele selecionasse dentro da tabela, mas essa linha esta selecionando a primeira célula depois da tabela criada.
O cadastro está ficando abaixo da planilha como mostra o print:
Qual seria o código para usar a minha tabela de nome AgendadordeEventos como a base de dados do formulário?
spiders,
Altere a seguinte linha
linha = Sheets(“BASE”).Cells(Rows.Count, “E”).End(xlUp).Offset(1, 0).Row
Para :
linha = ThisWorkBook.Sheets(“AgendadordeEventos”).Cells(Rows.Count, “E”).End(xlUp).Row + 1
Espero ter ajudado.
Abs.
Saulo Robles
Boa tarde, eu fiz a alteração na linha, porém retornou o seguinte erro
Erro em tempo de execução '9':
Subscrito fora do intervalo
spiders,
Na sua pasta de trabalho, qual o nome da guia que serve como Base de dados? AgendadordeEventos ou BASE?
Apenas altere isso na linha que faz referência á guia que é sua base de dados.
Espero ter ajudado.
Abs.
Saulo Robles
Bom dia, a guia se chama "Base", mas a tabela se chama "AgendadorDeEventos".
Obrigado
spiders,
Se puder, suba seu modelo em sites de compartilhamento como, sendspace, google drive etc... e disponibilize o link para que possamos analisar e tentar auxiliá-lo.
Para postar o link, use a ferramenta URL "linkdoarquivo" sem aspas.
Espero ter ajudado.
Abs.
Saulo Robles
Bom dia muito obrigado pela sua contribuição, agora a caixa de confinação está funcionando. Mas gostaria de quando eu finalizasse o cadastro, assim como as caixas de texto ficaram limpas, a caixa de combinação também ficasse em branco. Outro detalhe que continuo com problema é esse abaixo conforma a imagem:
Quando eu uso o formulário em VB para fazer o agendamento, na primeira linha a coluna "VALOR CALCULADO" fica formatado como data. Se essa coluna ficar formatada desse jeito as formulas na planilha não funciona. Quando eu cadastro manualmente uma data na tabela essa coluna "VALOR CALCULADO" fica formatado somente número e assim todas as fórmulas funcionam. O problema é que não sei o que está fazendo isso acontecer, porque todas as células dentro da tabela estão formatadas corretamente. O curioso é que se eu clico duas vezes na célula "data" da primeira linha que foi preenchida com o vba e depois desselecionar a célula, a celula da coluna "VALOR CALCULADO" fica formatada corretamente.
Spiders,
Para limpar o ComboBox, deixei algumas linhas comentadas no código que insere os dados na guia. Altere esta linha Me.ComboBox1.RemoveItem Me.ComboBox1.ListIndex para Me.ComboBox1 = "" e veja se tem o resultado desejado.
Na questão que se refere ao campo VALOR CALCULADO, a data deve entrar na guia como Data mesmo? Caso positivo (pois notei que se for dessa maneira), este campo ficaria com o valor ex: 4355|1), altere esta linha Sheet3.Cells(linha, 5).Value = Me.txtData.Value para Sheet3.Cells(linha, 5).Value = CDate(Me.txtData.Value). Assim o campo VALOR CALCULADO retornará o valor nesse formato.
Espero ter ajudado.
Abs.
Saulo Robles
Muito obrigado!! Era isso mesmo que estava acontecendo. Fiz a alteração que você recomendou e a coluna valor exclusivo agora está sendo formatada conforme o necessário.
Muito obrigado, era isso mesmo que eu estava precisando. Agora tenho mais um detalhe pra deixar a planilha do jeito que estou precisando. Como faço para não deixar meu formulário fazer um agendamento repetido, ou seja, caso a minha tabela já esteja preenchida com data e hora que alguém esteja tentando cadastrar novamente, eu preciso de uma condições que bloqueie isso. Como seria possível? Prometo que essa será a última dúvida do tópico, acredito que estou fazendo errado tirando várias dúvidas que não estão no tema do título.
Desde já agradeço a ajuda.
spiders,
Na janela de código do Userform, adicione logo na primeira linha :
Dim existeAgendamento As Boolean
No código do botão de cadastro, adicione as linhas abaixo antes da rotina que efetua o cadastro :
Call validaAgendamento(CStr(Me.txtData), CStr(Me.cboHora)) If existeAgendamento = True Then MsgBox "Data e Hora já utilizados em outro agendamento!", vbExclamation, "Erro" Exit Sub End If
E por fim, pode ser ao final dos códigos do UserForm, adicione a Function abaixo :
Function validaAgendamento(ByVal Data As String, ByVal Hora As String) existeAgendamento = False With ThisWorkbook.Sheets("Base") Dim vData As String, vHora As String Dim linhaAtual As Long linhaAtual = 3 Do vData = CStr(.Cells(linhaAtual, 5)) vHora = Format(.Cells(linhaAtual, 6), "h:mm") If vData = CStr(Data) Then If vHora = CStr(Hora) Then existeAgendamento = True Exit Do End If End If linhaAtual = linhaAtual + 1 Loop While .Cells(linhaAtual, 5) <> "" 'linhaAtual <= linhaFinal End With End Function
Espero ter ajudado.
Abs.
Saulo Robles
Boa tarde, eu estou recebendo um erro que me retorna a mensagem para adicionar um End Sub, porém se eu adicionar esse End Sub ele ficará no meio do código.
Segue o código abaixo:
Private Sub btnAgendar_Click() Dim idHora As Long linha = IIf(Sheets("Base").Range("AgendadordeEventos").Cells(1, 1) = "", 3, Sheets("Base").Range("AgendadordeEventos").Cells(0, 1).End(4).Row + 1) idHora = Me.cboHora.ListIndex 'Nova rotina para validar agendamento Call validaAgendamento(CStr(Me.txtData), CStr(Me.cboHora)) If existeAgendamento = True Then MsgBox "Data e Hora já utilizados em outro agendamento!", vbExclamation, "Erro" Exit Sub End If 'Para que a data entre como texto, formate a coluna como GERAL 'pois a linha abaixo insere o valor como TEXTO( String ) Sheet3.Cells(linha, 5).Value = CDate(Me.txtData.Value) 'Aqui inserimos valor com formato de Hora:Minutos Sheet3.Cells(linha, 6).Value = Format(Me.cboHora.Value, "hh:mm") Sheet3.Cells(linha, 7).Value = UCase(Me.txtNome.Value) Sheet3.Cells(linha, 8).Value = UCase(Me.txtRamal.Value) Sheet3.Cells(linha, 9).Value = UCase(Me.txtAssunto.Value) 'Columns.AutoFit MsgBox "Agendamento concluído", vbInformation, "Agendamento de Reunião" Me.txtData.Value = "" 'Se desejar remover o horário cadastrado da lista 'descomente a linha abaixo 'Me.cboHora.RemoveItem Me.cboHora.ListIndex Me.txtNome.Value = "" Me.cboHora.Value = "" Me.txtRamal.Value = "" Me.txtAssunto.Value = "" End Sub Private Sub TextBox2_Change() End Sub Private Sub btnSair_Click() Unload frmAgendamentoCGH End Sub Private Sub cbHora_Change() End Sub Private Sub cboHora_Change() End Sub Private Sub Image1_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer) End Sub Private Sub txtData_Change() End Sub Private Sub txtData_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then txtData = Format(txtData, "@@/@@/@@@@") End If End Sub Private Sub txtHora_Change() End Sub Private Sub txtHora_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then txtHora = Format(txtHora, "@@:@@") End If End Sub Private Sub UserForm_Click() End Sub Private Sub UserForm_Initialize() Dim existeAgendamento As Boolean With cboHora .Style = fmStyleDropDownCombo .Clear For vLinha = 3 To ThisWorkbook.Sheets("Intervalo").Cells(Rows.Count, 5).End(xlUp).Row - 1 If ThisWorkbook.Sheets("Intervalo").Cells(vLinha, 5) <> "" Then .AddItem ThisWorkbook.Sheets("Intervalo").Cells(vLinha, 5).Text End If Next .Style = fmStyleDropDownList .ListIndex = 0 End With 'Adicionando código para condição de agendamento Function validaAgendamento(ByVal Data As String, ByVal Hora As String) existeAgendamento = False With ThisWorkbook.Sheets3("Base") Dim vData As String, vHora As String Dim linhaAtual As Long linhaAtual = 3 Do vData = CStr(.Cells(linhaAtual, 5)) vHora = Format(.Cells(linhaAtual, 6), "h:mm") If vData = CStr(Data) Then If vHora = CStr(Hora) Then existeAgendamento = True Exit Do End If End If linhaAtual = linhaAtual + 1 Loop While .Cells(linhaAtual, 5) <> "" 'linhaAtual <= linhaFinal End With End Function End Sub
Qual seria o local correto para adicionar os códigos no UserForm?
spiders,
Se os códigos acima forem tudo o que está dentro do frmAgendamentoCGH, copie tudo para um bloco de notas (só por garantia) e remova tudo. Após isso, substitua pelo conteúdo que deixo abaixo e teste.
Dim existeAgendamento As Boolean Private Sub btnAgendar_Click() Dim idHora As Long 'Nova rotina para validar agendamento Call validaAgendamento(CStr(Me.txtData), CStr(Me.cboHora)) If existeAgendamento = True Then MsgBox "Data e Hora já utilizados em outro agendamento!", vbExclamation, "Erro" Exit Sub End If linha = IIf(Sheets("Base").Range("AgendadordeEventos").Cells(1, 1) = "", 3, Sheets("Base").Range("AgendadordeEventos").Cells(0, 1).End(4).Row + 1) idHora = Me.cboHora.ListIndex 'Para que a data entre como texto, formate a coluna como GERAL 'pois a linha abaixo insere o valor como TEXTO( String ) Sheet3.Cells(linha, 5).Value = CDate(Me.txtData.Value) 'Aqui inserimos valor com formato de Hora:Minutos Sheet3.Cells(linha, 6).Value = Format(Me.cboHora.Value, "hh:mm") Sheet3.Cells(linha, 7).Value = UCase(Me.txtNome.Value) Sheet3.Cells(linha, 8).Value = UCase(Me.txtRamal.Value) Sheet3.Cells(linha, 9).Value = UCase(Me.txtAssunto.Value) 'Columns.AutoFit MsgBox "Agendamento concluído", vbInformation, "Agendamento de Reunião" Me.txtData.Value = "" 'Se desejar remover o horário cadastrado da lista 'descomente a linha abaixo 'Me.cboHora.RemoveItem Me.cboHora.ListIndex Me.txtNome.Value = "" Me.cboHora.Value = "" Me.txtRamal.Value = "" Me.txtAssunto.Value = "" End Sub Private Sub btnSair_Click() Unload frmAgendamentoCGH End Sub Private Sub txtData_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then txtData = Format(txtData, "@@/@@/@@@@") End If End Sub Private Sub txtHora_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then txtHora = Format(txtHora, "@@:@@") End If End Sub Private Sub UserForm_Initialize() With cboHora .Style = fmStyleDropDownCombo .Clear For vLinha = 3 To ThisWorkbook.Sheets("Intervalo").Cells(Rows.Count, 5).End(xlUp).Row - 1 If ThisWorkbook.Sheets("Intervalo").Cells(vLinha, 5) <> "" Then .AddItem ThisWorkbook.Sheets("Intervalo").Cells(vLinha, 5).Text End If Next .Style = fmStyleDropDownList .ListIndex = 0 End With End Sub 'Adicionando código para condição de agendamento Function validaAgendamento(ByVal Data As String, ByVal Hora As String) existeAgendamento = False With ThisWorkbook.Sheets3("Base") Dim vData As String, vHora As String Dim linhaAtual As Long linhaAtual = 3 Do vData = CStr(.Cells(linhaAtual, 5)) vHora = Format(.Cells(linhaAtual, 6), "h:mm") If vData = CStr(Data) Then If vHora = CStr(Hora) Then existeAgendamento = True Exit Do End If End If linhaAtual = linhaAtual + 1 Loop While .Cells(linhaAtual, 5) <> "" 'linhaAtual <= linhaFinal End With End Function
Espero ter ajudado.
Abs.
Saulo Robles
Muito obrigado, está funcionando toda a lógica da planilha. Te agradeço muito e agora vou começar a estudar mais o VB para começar a fazer mais planilhas dessa forma.
Abraços