Alimentando tabela referenciada com formulario VBA  [Resolvido]

Text Box, Form's, rotinas, etc.
Regras do fórum
Sua dúvida foi respondida? Marque como RESOLVIDO em seus tópicos, usando o botão com marca verde. Imagem

Re: Alimentando tabela referenciada com formulario VBA  [Resolvido]

Mensagempor spiders » Seg Out 21, 2019 9:03 am

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.
spiders
Membro
Membro
 
Mensagens: 10
Registrado em: Sex Out 11, 2019 1:38 pm
Has thanked: 0 time
Have thanks: 1 time

{ SO_SELECT }

Re: Alimentando tabela referenciada com formulario VBA

Mensagempor spiders » Seg Out 21, 2019 10:17 am

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
Membro
Membro
 
Mensagens: 10
Registrado em: Sex Out 11, 2019 1:38 pm
Has thanked: 0 time
Have thanks: 1 time

Re: Alimentando tabela referenciada com formulario VBA

Mensagempor srobles » Seg Out 21, 2019 5:22 pm

spiders,

Na janela de código do Userform, adicione logo na primeira linha :
Código: Selecionar todos
Dim existeAgendamento As Boolean

No código do botão de cadastro, adicione as linhas abaixo antes da rotina que efetua o cadastro :
Código: Selecionar todos
    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 :
Código: Selecionar todos
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

Remember when you were young?
You shone like the sun.
Shine On You Crazy Diamond
srobles
Membro
Membro
 
Mensagens: 378
Registrado em: Sáb Mai 09, 2015 10:35 pm
Has thanked: 122 times
Have thanks: 162 times

Re: Alimentando tabela referenciada com formulario VBA

Mensagempor spiders » Ter Out 22, 2019 1:43 pm

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:

Código: Selecionar todos
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
Membro
Membro
 
Mensagens: 10
Registrado em: Sex Out 11, 2019 1:38 pm
Has thanked: 0 time
Have thanks: 1 time

Re: Alimentando tabela referenciada com formulario VBA

Mensagempor srobles » Ter Out 22, 2019 2:02 pm

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.
Código: Selecionar todos
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

Remember when you were young?
You shone like the sun.
Shine On You Crazy Diamond
srobles
Membro
Membro
 
Mensagens: 378
Registrado em: Sáb Mai 09, 2015 10:35 pm
Has thanked: 122 times
Have thanks: 162 times

Re: Alimentando tabela referenciada com formulario VBA

Mensagempor spiders » Qua Out 23, 2019 10:09 am

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

For this post the author spiders thanked:
srobles (Sex Nov 01, 2019 1:40 pm)
spiders
Membro
Membro
 
Mensagens: 10
Registrado em: Sex Out 11, 2019 1:38 pm
Has thanked: 0 time
Have thanks: 1 time

Anterior

Voltar para Formulários

Quem está online

Usuários navegando neste fórum: Google Adsense [Bot] e 1 visitante