Jump to content
Fórum Script Brasil
  • 0
Sign in to follow this  
xmiguelx

DIA ÚTIL E CONTAGEM DE PRAZO EM DIA ÚTIL.

Question

Olá pessoal,

Preciso de uma mega ajuda:
Tenho uma planilha com duas colunas com fórmulas e gostaria de passar para Macro/VB ao abrir o chamado através do formulário.

Fiz uma planilha de exemplo para facilitar no entendimento.

1) Tenho um formulário onde preencho com alguns dados para abertura de chamado.
==> Ao clicar em enviar eu salvo as informações na sheet SOLICITACAO, e na coluna D eu tenho uma fórmula onde verifico se a data que foi criado o chamado é dia útil, caso seja, será a mesma data e horário da abertura do chamado, caso contrário será o próximo dia útil considerando o horário do inicio da jornada de trabalho conforme o tipo de chamado.
- O Horario do inicio do chamado está na sheet CATEGORIA, coluna E

==> A Coluna L da Sheet SOLICITACAO é calculado o prazo previsto do atendimento considerando o dia e horário da coluna D + o prazo da coluna K, eliminando Sábado, domingo e feriado.
- Tenho uma sheet DSR onde informo os feriados na coluna D.

Abs

Planilha de Exemplo

Share this post


Link to post
Share on other sites

4 answers to this question

Recommended Posts

  • 0

Vou adiantando as informações.

Código de Cadastro:

Sub CadastrarSolicitacao()
Dim LINHAS As Integer
Dim NDay As Double
Dim NDayPrev As Double

    If frm_ficha_solicitacao.ComboBox_TipoDeCHAMADO.Value = "" Then
        MsgBox ("Favor preencher o Tipo de Chamado."), vbCritical, Msg
        frm_ficha_solicitacao.ComboBox_TipoDeCHAMADO.SetFocus
    ElseIf frm_ficha_solicitacao.txt_cnpj.Value = "" Then
        MsgBox ("Favor preencher o CNPJ do destinatário."), vbCritical, Msg
        frm_ficha_solicitacao.txt_cnpj.SetFocus
    ElseIf frm_ficha_solicitacao.txt_empresa.Value = "" Then
        MsgBox ("Favor preencher a Empresa."), vbCritical, Msg
        frm_ficha_solicitacao.txt_empresa.SetFocus
    ElseIf frm_ficha_solicitacao.txt_chamado.Value = "" Then
        MsgBox ("Favor descrever á solicitação."), vbCritical, Msg
        frm_ficha_solicitacao.txt_chamado.SetFocus
    Else
        With Sheets("SOLICITACAO")
            'Pesquisa a ultima linha para adcionar as informações
            'LINHA = Sheets("SOLICITACAO").Range("B30000").End(xlUp).Row + 1
            LINHA = .Cells(Rows.Count, "B").End(xlUp).Row + 1
            
            'Iniciar o cadastro das informações
            
            .Range("B" & LINHA).Value = frm_ficha_solicitacao.NCHAMADO.Value
            .Range("C" & LINHA).Value = Now()
            'Recebe o valor do dia util mais próximo:
            If Weekday(Now()) > 1 And _
               Weekday(Now()) < 7 And _
               WorksheetFunction.VLookup(CDbl(Now()), [DSR], 1, 1) <> Int(CDbl(Now())) Then
                NDay = Now()
            Else
                NDay = WorksheetFunction.WorkDay(Now(), 1, [DSR]) + _
                        fnTipoChamadoHoras(frm_ficha_solicitacao.ComboBox_TipoDeCHAMADO.Value, "Início")
                NDayPrev = NDay + _
                            fnTipoChamadoHoras(frm_ficha_solicitacao.ComboBox_TipoDeCHAMADO.Value, "Prazo")
            End If
            
            .Range("D" & LINHA).Value = NDay
            
            
            'Colunas sem informações: (Marcadas em amarelo)
            'E
            'F
            'G
            'H
            
           .Range("I" & LINHA).Value = frm_ficha_solicitacao.ComboBox_TipoDeCHAMADO.Value
            
            For Contador = 3 To Sheets("CATEGORIA").Range("B100").End(xlUp).Row
                If Sheets("CATEGORIA").Range("B" & Contador).Value = frm_ficha_solicitacao.ComboBox_TipoDeCHAMADO.Value Then
                    .Range("J" & LINHA).Value = Sheets("CATEGORIA").Range("D" & Contador).Value
                    .Range("K" & LINHA).Value = Sheets("CATEGORIA").Range("C" & Contador).Value
                End If
            Next Contador
            
            'Recebe o valor do dia util mais próximo:
            
            Sheets("SOLICITACAO").Range("L" & LINHA).Value = NDayPrev
            
            'Colunas sem informações: (Marcadas em amarelo)
            'M
            'N
            
            .Range("O" & LINHA).Value = frm_ficha_solicitacao.txt_cnpj.Value
            .Range("V" & LINHA).Value = frm_ficha_solicitacao.txt_empresa.Value
            .Range("W" & LINHA).Value = frm_ficha_solicitacao.txt_chamado.Value
        End With
    
        MsgBox ("Seu chamar foi aberto sob NÚMERO: " & frm_ficha_solicitacao.NCHAMADO.Value + vbCrLf + vbCrLf + _
                " Prazo para atendimento: " & XXXXXX), vbExclamation, Msg
        
        Unload frm_ficha_solicitacao
    
    End If
    
End Sub

 

Função para identificar a Horas pela Categoria:

Public Function fnTipoChamadoHoras(TipoChadado As String, Tipo As String) As Double
Dim NLinha As Integer
Dim NLinhaAtual As Integer
Dim TipoLinhaAtual As String
    NLinha = Sheets("CATEGORIA").Cells(Rows.Count, "B").End(xlUp).Row
    For NLinhaAtual = 3 To NLinha Step 1
        TipoLinhaAtual = Sheets("CATEGORIA").Range("B" & NLinhaAtual).Value
        If TipoLinhaAtual = TipoChadado Then
            If Tipo = "Prazo" Then
                fnTipoChamadoHoras = Sheets("CATEGORIA").Range("C" & NLinhaAtual).Value
            ElseIf Tipo = "Início" Then
                fnTipoChamadoHoras = Sheets("CATEGORIA").Range("E" & NLinhaAtual).Value
            End If
        End If
    Next NLinhaAtual
End Function

Arquivo: EXEMPLO_DATA&HORA.xlsm

@xmiguelx

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Sign in to follow this  

Cloud Computing


  • Forum Statistics

    • Total Topics
      148393
    • Total Posts
      643786
×
×
  • Create New...