Não deixar agendar mesma data horario e sala

Visual Basic for Aplication e macros no Excel.
Regras do fórum
Sua dúvida foi respondida? Marque como RESOLVIDO em seus tópicos, usando o botão com marca verde. Imagem

Não deixar agendar mesma data horario e sala

Mensagempor fcarlosc » Qua Dez 05, 2018 11:43 am

Boa-tarde Galera

Gostaria de uma macro que não deixe agendar na mesma data, horário e sala.
Lembro de ter visto alguma coisa parecida aqui no Forum, pesquisei mais não encontrei.
Se puderem dar uma força, agradeço...!

Att,
Francisco
Você não está autorizado a ver ou baixar esse anexo.
Avatar do usuário
fcarlosc
Membro
Membro
 
Mensagens: 458
Registrado em: Qui Jan 28, 2016 4:23 pm
Localização: São Paulo
Has thanked: 80 times
Have thanks: 101 times

{ SO_SELECT }

Re: Não deixar agendar mesma data horario e sala

Mensagempor wagner » Qua Dez 05, 2018 3:46 pm

fcarlosc,

Boa tarde!

Veja se é assim.
Você não está autorizado a ver ou baixar esse anexo.
Se a resposta foi útil para você, por gentileza, Amigo, clique na mãozinha ao lado direito da ferramenta CITAR, no canto superior direito.

Atenciosamente
Wagner Morel

For this post the author wagner thanked:
fcarlosc (Qua Dez 05, 2018 4:57 pm)
Avatar do usuário
wagner
Moderador
Moderador
 
Mensagens: 4530
Registrado em: Sáb Out 20, 2012 12:49 pm
Localização: Fortaleza - CE
Has thanked: 71 times
Have thanks: 1951 times

Re: Não deixar agendar mesma data horario e sala

Mensagempor fcarlosc » Qua Dez 05, 2018 9:08 pm

Boa-noite wagner

Obrigado pela resposta, fiz uns testes e tem vez que bloqueia e outras não, acaba agendando com duplicidade.
Avatar do usuário
fcarlosc
Membro
Membro
 
Mensagens: 458
Registrado em: Qui Jan 28, 2016 4:23 pm
Localização: São Paulo
Has thanked: 80 times
Have thanks: 101 times

Re: Não deixar agendar mesma data horario e sala

Mensagempor wagner » Qua Dez 05, 2018 9:14 pm

Ok. Cite casos para testes.
Se a resposta foi útil para você, por gentileza, Amigo, clique na mãozinha ao lado direito da ferramenta CITAR, no canto superior direito.

Atenciosamente
Wagner Morel

For this post the author wagner thanked:
fcarlosc (Qua Dez 05, 2018 9:17 pm)
Avatar do usuário
wagner
Moderador
Moderador
 
Mensagens: 4530
Registrado em: Sáb Out 20, 2012 12:49 pm
Localização: Fortaleza - CE
Has thanked: 71 times
Have thanks: 1951 times

Re: Não deixar agendar mesma data horario e sala

Mensagempor fcarlosc » Qua Dez 05, 2018 9:23 pm

Então...a linha 2 já está preenchida (código 1), abro o formulário e tento inserir as mesmas informações novamente ele bloqueia (blz)...se eu altero por ex.: a Sala de SALA-1 para SALA-2, grava de boa (código 2).
Agora, quando vou inserir o (código 3) com as mesmas informações do (código 2) ele aceita. Com as mesmas informações do (código 1) ele bloqueia.
Avatar do usuário
fcarlosc
Membro
Membro
 
Mensagens: 458
Registrado em: Qui Jan 28, 2016 4:23 pm
Localização: São Paulo
Has thanked: 80 times
Have thanks: 101 times

Re: Não deixar agendar mesma data horario e sala

Mensagempor wagner » Qui Dez 06, 2018 2:19 pm

fcarlosc,

Boa tarde!

Ok. Havia uma série de erros de lógica. Creio que corrigi todos. Teste e veja se é assim.
Você não está autorizado a ver ou baixar esse anexo.
Se a resposta foi útil para você, por gentileza, Amigo, clique na mãozinha ao lado direito da ferramenta CITAR, no canto superior direito.

Atenciosamente
Wagner Morel

For this post the author wagner thanked: 2
fcarlosc (Qui Dez 06, 2018 2:25 pm) • jeffbart (Sáb Dez 08, 2018 9:12 am)
Avatar do usuário
wagner
Moderador
Moderador
 
Mensagens: 4530
Registrado em: Sáb Out 20, 2012 12:49 pm
Localização: Fortaleza - CE
Has thanked: 71 times
Have thanks: 1951 times

Re: Não deixar agendar mesma data horario e sala

Mensagempor fcarlosc » Qui Dez 06, 2018 2:30 pm

Boa-tarde wagner

Funcionou blz...vou fazendo alguns testes e tbm vou tentar adaptar ao meu formulário original.
Qualquer coisa retorno

Att,

Francisco
Avatar do usuário
fcarlosc
Membro
Membro
 
Mensagens: 458
Registrado em: Qui Jan 28, 2016 4:23 pm
Localização: São Paulo
Has thanked: 80 times
Have thanks: 101 times

Re: Não deixar agendar mesma data horario e sala

Mensagempor JSCOPA » Qui Dez 06, 2018 2:47 pm

.
Só linkando tópicos "idênticos" ... viewtopic.php?f=10&t=29790
.
JSCOPA
.
Se a resposta foi útil, agradeça clicando na mãozinha!! ... Se resolveu, clique em "resolvido"!!
Avatar do usuário
JSCOPA
Membro
Membro
 
Mensagens: 1375
Registrado em: Sáb Jul 04, 2009 7:54 pm
Has thanked: 208 times
Have thanks: 388 times

Re: Não deixar agendar mesma data horario e sala

Mensagempor fcarlosc » Qui Dez 06, 2018 5:03 pm

Boa-noite wagner

Meu código está assim:

Código: Selecionar todos
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)

Select Case Button.Index
 
 
Dim ultimalinha

Dim lastRow
Dim X
Dim li
Dim linha
Dim Contador
 
Dim i
Dim exitApp
 
Case Is = 1 'SALVAR
           
If WorksheetFunction.CountIf(Range("A1:A10000"), txtCodigo.Value) > 0 And txtCodigo <> "" Then
        MsgBox "CÓDIGO JÁ CADASTRADO", vbInformation, "AVISO"
       
             ElseIf Me.cbxSolicitante = "" Then
             'Cancel = False
             MsgBox "PREENCHER NOME", vbCritical, "ERRO"
         
             Else
               
                  Sheets("Atendimentos").Select
                  Range("A60000").End(xlUp).Select
                  ActiveCell.Offset(1, 0).Select
                  ActiveCell = Me.txtCodigo
                  ActiveCell.Offset(0, 1) = UCase(Format(txtRegistro, "mm/dd/yyyy"))
                  ActiveCell.Offset(0, 2) = UCase(cbxAbertura)
                  ActiveCell.Offset(0, 3) = UCase(cbxSolicitante)
                  ActiveCell.Offset(0, 4) = UCase(txtRamal)
                  ActiveCell.Offset(0, 5) = UCase(txtSetor)
                  ActiveCell.Offset(0, 6) = UCase(txtDescricao)
                  ActiveCell.Offset(0, 7) = UCase(cbxPrioridade)
                  ActiveCell.Offset(0, 8) = UCase(Format(txtPrevista, "mm/dd/yyyy"))
                  ActiveCell.Offset(0, 9) = UCase(Format(txtConclusao, "mm/dd/yyyy"))
                  ActiveCell.Offset(0, 10) = UCase(cbxFechamento)
                  ActiveCell.Offset(0, 11) = UCase(txtResolucao)
                  ActiveCell.Offset(0, 12) = UCase(cbxStatus)
           
            ActiveWorkbook.Save
           
                       MsgBox "REUNIÃO AGENDADA COM SUCESSO", vbInformation, "INFORMAÇÃO"
           
            End If
                   
                   
            'ATUALIZAR O LISTVEW1 - É NECESSÁRIO APAGAR O LISTVIEW, ATRAVÉS DO CLEAR ABAIXO E DEPOIS MOSTRAR OS CAMPOS ATUALIZADOS
            'PEGUEI OS COMANDOS ABAIXO NO EVENTO INITIALIZE
           
             ListView1.ListItems.Clear 'APAGA O LISTVIEW1 PARA ATUALIZAR
           
             lastRow = Plan1.Cells(Rows.Count, "a").End(xlUp).Row
                    'Adiciona itens
                    For X = 2 To lastRow
                        Set li = ListView1.ListItems.Add(text:=Plan1.Cells(X, "a").Value)
                        li.ListSubItems.Add text:=Plan1.Cells(X, "b").Value
                        li.ListSubItems.Add text:=Format(Plan1.Cells(X, "c").Value, "hh:mm")
                        li.ListSubItems.Add text:=Plan1.Cells(X, "d").Value
                        li.ListSubItems.Add text:=Plan1.Cells(X, "e").Value
                        li.ListSubItems.Add text:=Plan1.Cells(X, "f").Value
                        li.ListSubItems.Add text:=Plan1.Cells(X, "g").Value
                        li.ListSubItems.Add text:=Plan1.Cells(X, "h").Value
                        li.ListSubItems.Add text:=Plan1.Cells(X, "i").Value
                        li.ListSubItems.Add text:=Plan1.Cells(X, "j").Value
                        li.ListSubItems.Add text:=Format(Plan1.Cells(X, "k").Value, "hh:mm")
                        li.ListSubItems.Add text:=Plan1.Cells(X, "l").Value
                        li.ListSubItems.Add text:=Plan1.Cells(X, "m").Value
                                                                                                                                               
                   Next
                   
                   
            'txtCodigo = ""
            'txtRegistro = ""
            cbxAbertura = ""
            cbxSolicitante = ""
            txtRamal = ""
            txtSetor = ""
            txtDescricao = ""
            cbxPrioridade = ""
            txtPrevista = ""
            txtConclusao = ""
            cbxFechamento = ""
            txtResolucao = ""
            cbxStatus = ""
           
            cbxAbertura.SetFocus
           
           
            cli_reg_numero.Caption = ListView1.ListItems.Count
                           
                                           
             linha = 2    'CRIAR UM CONTADOR PARA CADA CLIENTE NOVO
                        Contador = 0
                       
                        Do Until Sheets("Atendimentos").Cells(linha, 1) = ""
                        If Sheets("Atendimentos").Cells(linha, 1) > Contador Then
                                                           
                        Contador = Contador + 1
                        linha = linha + 1
                        Else
                        End If
                        Loop
                        Contador = Contador + 1
                        txtCodigo = Range("A1").End(xlDown).Value + 1
                           

         
Case Is = 3 'EDITAR
       
       
              ultimalinha = Plan1.Cells(Plan3.Cells.Rows.Count, "a").End(xlUp).Row + 1
                For i = 2 To ultimalinha
                    If txtCodigo = Plan1.Cells(i, 1) Then
                   
                    Plan1.Cells(i, 2) = UCase(Format(txtRegistro, "mm/dd/yyyy"))
                    Plan1.Cells(i, 3) = UCase(cbxAbertura)
                    Plan1.Cells(i, 4) = UCase(cbxSolicitante)
                    Plan1.Cells(i, 5) = UCase(txtRamal)
                    Plan1.Cells(i, 6) = UCase(txtSetor)
                    Plan1.Cells(i, 7) = UCase(txtDescricao)
                    Plan1.Cells(i, 8) = UCase(cbxPrioridade)
                    Plan1.Cells(i, 9) = UCase(Format(txtPrevista, "mm/dd/yyyy"))
                    Plan1.Cells(i, 10) = UCase(Format(txtConclusao, "mm/dd/yyyy"))
                    Plan1.Cells(i, 11) = UCase(cbxFechamento)
                    Plan1.Cells(i, 12) = UCase(txtResolucao)
                    Plan1.Cells(i, 13) = UCase(cbxStatus)
                                 
               Exit For
                       
                  End If
                   Next
           
                   For i = 1 To ListView1.ListItems.Count
                       If ListView1.ListItems.Item(i) = txtCodigo Then
                       
                            ListView1.ListItems.Item(i).SubItems(1) = UCase(txtRegistro)
                            ListView1.ListItems.Item(i).SubItems(2) = UCase(cbxAbertura)
                            ListView1.ListItems.Item(i).SubItems(3) = UCase(cbxSolicitante)
                            ListView1.ListItems.Item(i).SubItems(4) = UCase(txtRamal)
                            ListView1.ListItems.Item(i).SubItems(5) = UCase(txtSetor)
                            ListView1.ListItems.Item(i).SubItems(6) = UCase(txtDescricao)
                            ListView1.ListItems.Item(i).SubItems(7) = UCase(cbxPrioridade)
                            ListView1.ListItems.Item(i).SubItems(8) = UCase(txtPrevista)
                            ListView1.ListItems.Item(i).SubItems(9) = UCase(txtConclusao)
                            ListView1.ListItems.Item(i).SubItems(10) = UCase(cbxFechamento)
                            ListView1.ListItems.Item(i).SubItems(11) = UCase(txtResolucao)
                            ListView1.ListItems.Item(i).SubItems(12) = UCase(cbxStatus)
                           
                    ActiveWorkbook.Save
                           
                            MsgBox "REUNIÃO ALTERADA COM SUCESSO", vbInformation, "INFORMAÇÃO"
                                                 
                            Exit For
                           
                        End If
                    Next
                   
                            'txtCodigo = ""
                            'txtRegistro = ""
                            cbxAbertura = ""
                            cbxSolicitante = ""
                            txtRamal = ""
                            txtSetor = ""
                            txtDescricao = ""
                            cbxPrioridade = ""
                            txtPrevista = ""
                            txtConclusao = ""
                            cbxFechamento = ""
                            txtResolucao = ""
                            cbxStatus = ""
                           
                            cbxAbertura.SetFocus
           
                                           
             linha = 2    'CRIAR UM CONTADOR PARA CADA CLIENTE NOVO
                        Contador = 0
                       
                        Do Until Sheets("Atendimentos").Cells(linha, 1) = ""
                        If Sheets("Atendimentos").Cells(linha, 1) > Contador Then
                                                           
                        Contador = Contador + 1
                        linha = linha + 1
                        Else
                        End If
                        Loop
                        Contador = Contador + 1
                        txtCodigo = Range("A1").End(xlDown).Value + 1

Case Is = 5 'LIMPAR
       
                            'txtCodigo = ""
                            'txtRegistro = ""
                            cbxAbertura = ""
                            cbxSolicitante = ""
                            txtRamal = ""
                            txtSetor = ""
                            txtDescricao = ""
                            cbxPrioridade = ""
                            txtPrevista = ""
                            txtConclusao = ""
                            cbxFechamento = ""
                            txtResolucao = ""
                            cbxStatus = ""
                           
                            cbxAbertura.SetFocus
       
             linha = 2    'CRIAR UM CONTADOR PARA CADA CLIENTE NOVO
                        Contador = 0
                       
                        Do Until Sheets("Atendimentos").Cells(linha, 1) = ""
                        If Sheets("Atendimentos").Cells(linha, 1) > Contador Then
                                                           
                        Contador = Contador + 1
                        linha = linha + 1
                        Else
                        End If
                        Loop
                        Contador = Contador + 1
                        'txtCodigo = Range("A1").End(xlDown).Value + 1
                        txtCodigo = Range("N1").Value + 1
       
Case Is = 7 'EXCLUIR
       
MsgBox "Esta opção foi desabilitada pelo Administrador do Sistema"
                   
Case Is = 9 'SAIR
       
If MsgBox("Deseja realmente encerrar o aplicativo?", vbQuestion + vbYesNo, "Sair") = vbYes Then
        On Error GoTo vErro
        exitApp = False
        ThisWorkbook.Save
            If Application.Windows.Count >= 2 Then
                Application.Visible = True
                ThisWorkbook.Close
            Else
                If Application.Windows.Count = 1 Then
                    Application.Quit
                End If
            End If
vErro:
If Err <> 0 Then MsgBox Err.Number & " - " & Err.Description
End If
   
End Select

End Sub


Tentei adaptar com o código do arquivo que você enviou, uma hora dá erro de Select Case, outra tentativa não aparece erro, porém não grava os dados.

Att,
Francisco
Avatar do usuário
fcarlosc
Membro
Membro
 
Mensagens: 458
Registrado em: Qui Jan 28, 2016 4:23 pm
Localização: São Paulo
Has thanked: 80 times
Have thanks: 101 times

Re: Não deixar agendar mesma data horario e sala

Mensagempor wagner » Sex Dez 07, 2018 8:11 am

fcarlosc,

Bom dia!

Entendi... infelizmente, não faço a menor ideia do que possa ser.
Se a resposta foi útil para você, por gentileza, Amigo, clique na mãozinha ao lado direito da ferramenta CITAR, no canto superior direito.

Atenciosamente
Wagner Morel

For this post the author wagner thanked:
fcarlosc (Sex Dez 07, 2018 8:13 pm)
Avatar do usuário
wagner
Moderador
Moderador
 
Mensagens: 4530
Registrado em: Sáb Out 20, 2012 12:49 pm
Localização: Fortaleza - CE
Has thanked: 71 times
Have thanks: 1951 times

Próximo

Voltar para VBA & Macros

Quem está online

Usuários navegando neste fórum: Google Feedfetcher e 2 visitantes