Nesse Post mostro como fazer a soma no excel com VBA... essa soma pode ser aplicada a formulários e pode ser configurada de diversas maneiras... ideal para controle de banco de horas ou soma de tempo de serviços...
A função Abaixo deve ser colada dentro de um módulo no editor VBA do excel. O formato será definido via código adicionando-se o comando da função FormatInterval da seguinte maneira:
FormatInterval(sua_variável,"Formato")
Os formatos são listados na figura abaixo:
Para mais detalhes assista o vídeo no início deste post. Código da Função a ser colada em um módulo:
Function FormatInterval(ByVal Interval As Variant, Fmt As String) 'Formata a diferença entre duas datas ou a soma 'mostraem formato de dia, horas, minutos e segundos. ' Suporta os seguintes formatos: ' D H 5 Days 5 Hours ' D H:MM 5 Days 5:15 ' D HH:MM 5 Days 05:15 ' D H:MM:SS 5 Days 5:15:45 ' D HH:MM:SS 5 Days 05:15:45 ' H M 125 Hours 15 Minutes ' H:MM 125:15 ' H:MM:SS 125:15:45 ' M S 7515 Minutes 45 Seconds ' Dim Days As Long, Hours As Long, Minutes As Long, Seconds As Long ' ' Verifica Date or Double ' If VarType(Interval) <> 7 And VarType(Interval) <> 5 Then Exit Function ' ' Analisa os dias ' Days = Int(Interval) Interval = Interval - Days If Interval > #11:59:59 PM# Then Days = Days + 1 Interval = 0# End If ' ' Analisa as horas ' Interval = Interval * 24 Hours = Int(Interval) Interval = Interval - Hours If Interval > 3599# / 3600# Then Hours = Hours + 1 Interval = 0# End If ' ' Analisa os minutos ' Interval = Interval * 60 Minutes = Int(Interval) Interval = Interval - Minutes If Interval > 59# / 60# Then Minutes = Minutes + 1 Interval = 0# End If ' ' Analisa os segundos ' Seconds = Int(Interval * 60 + 0.5) ' ' Normalize ' If Seconds = 60 Then Minutes = Minutes + 1 Seconds = 0 End If If Minutes > 59 Then Hours = Hours + 1 Minutes = Minutes - 60 End If If Hours > 23 Then Days = Days + 1 Hours = Hours - 24 End If ' ' Criação do Formato ' Select Case Fmt Case "D H" FormatInterval = Days & IIf(Days <> 1, " Dias ", " Dia ") _ & Hours & IIf(Hours <> 1, " Horas", " Hora") Case "D H:MM" FormatInterval = Days & IIf(Days <> 1, " Dias ", " Dia ") _ & Hours & ":" & Format(Minutes, "00") Case "D HH:MM" FormatInterval = Days & IIf(Days <> 1, " Dias ", " Dia ") _ & Format(Hours, "00") & ":" & Format(Minutes, "00") Case "D H:MM:SS" FormatInterval = Days & IIf(Days <> 1, " Dias ", " Dia ") _ & Hours & ":" & Format(Minutes, "00") & ":" & Format(Seconds, "00") Case "D HH:MM:SS" FormatInterval = Days & IIf(Days <> 1, " Dias ", " Dia ") _ & Format(Hours, "00") & ":" & Format(Minutes, "00") & ":" _ & Format(Seconds, "00") Case "H M" Hours = Hours + Days * 24 FormatInterval = Hours & IIf(Hours <> 1, " Horas ", " Hora ") & Minutes _ & IIf(Minutes <> 1, " Minutos", " Minuto") Case "H:MM" Hours = Hours + Days * 24 FormatInterval = Hours & ":" & Format(Minutes, "00") Case "H:MM:SS" Hours = Hours + Days * 24 FormatInterval = Hours & ":" & Format(Minutes, "00") & ":" _ & Format(Seconds, "00") Case "M S" Minutes = Minutes + (Hours + Days * 24) * 60 FormatInterval = Minutes & IIf(Minutes <> 1, " Minutos ", " Minuto ") _ & Seconds & IIf(Seconds <> 1, " Segundos", " Segundo") Case Else FormatInterval = Null End Select End Function
O Código abaixo esta inserido Dentro do Procedimento Inicializar (Initiaze) de um Formulário. Ao ser aberto, o Código contido no procedimento Inicializar ira nomear as colunas da listview *, adicionar os dados **, e efetua a soma da coluna valor. ***
Private Sub UserForm_Initialize ()
'* Adiciona as colunas a ListView1 With ListView1 .Gridlines = True .View = lvwReport .FullRowSelect = True .ColumnHeaders.Add Text:="Mes", Width:=75 .ColumnHeaders.Add Text:="Quantidade", Width:=60 .ColumnHeaders.Add Text:="Valor", Width:=50, Alignment:=2 End With
ListView1.ListItems.Clear '** Adiciona os dados a ListView1
Sheets("dados").Select lin = 2 Do Until Sheets("dados").Cells(lin, 1) = "" Set li = ListView1.ListItems.Add(Text:=Sheets("dados").Cells(lin, 1).Value) 'mes li.ListSubItems.Add Text:=Sheets("dados").Cells(lin, 2).Value 'quant li.ListSubItems.Add Text:=Sheets("dados").Cells(lin, 3).Value 'Coluna a ser somada lin = lin + 1 Loop
'*** Efetua a soma e coloca o valor na Caixa de texto Chamada txt_soma Dim soma As Double For i = 1 To ListView1.ListItems.Count soma = soma + ListView1.ListItems.Item(i).SubItems(2) Next i txt_soma = soma
Supondo que o nome da TextBox que receberá a data étxt_vencimentotemos o seguinte código:
- O Procedimento KeyPress formatará o campo para que ao digitar sejam colocada as barras e o campo tenha o tamanho correto... se for adaptar ao seu código não esqueça de trocar todos os nomes de objetos txt_vencimento que aparece no código pelo nome da sua TextBox.
Private Sub txt_vencimento_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
txt_vencimento.MaxLength = 10 '10/10/2014 Select Case KeyAscii Case 8 'Aceita o BACK SPACE Case 13: SendKeys "{TAB}" 'Emula o TAB Case 48 To 57 If txt_vencimento.SelStart = 2 Then txt_vencimento.SelText = "/" If txt_vencimento.SelStart = 5 Then txt_vencimento.SelText = "/" Case Else: KeyAscii = 0 'Ignora os outros caracteres End Select
End Sub
- No procedimento AfterUpdate será feito o teste para verificar se o valor do dia esta entre 1 e 31, se o valor do mês esta entre 1 e 12 e também se a data digitada não é menor que a data atual, pois como se trata de um campo de vencimento não podemos ter uma data anterior.
Private Sub txt_vencimento_AfterUpdate()
Dim data As Date
data = Me.txt_vencimento
If Left(Me.txt_vencimento, 2) > 31 Then
MsgBox "Data preenchida de forma incorreta, dia inválido", vbExclamation, "Erro Data"
Me.txt_vencimento = ""
ElseIf Right(Left(Me.txt_vencimento, 5), 2) > 12 Then
MsgBox "Data preenchida de forma incorreta, mês inválido", vbExclamation, "Erro Data"
Me.txt_vencimento = ""
ElseIf data < Now Then
MsgBox "A data deve ser maior que hoje, cadastro não permitido", vbExclamation, "Erro Data"
Me.txt_vencimento = ""
End If
End Sub
* Entendendo o código ( Left e Right)
Right(Left(Me.txt_vencimento, 5), 2)
Supondo que tenha sido digitado a data 25/12/2014
O comando Right irá retornar os 2 caracteres da direita para esquerda que estiver contido dentro dele...
Como dentro do Right temos um Left... vamos descobrir o que o Left retorna para entender o código.
Left(Me.txt_vencimento, 5) esta retornando os 5 primeiros caracteres ou valores do conteúdo da caixa de texto txt_vencimento, ou seja 25/12.
Dessa forma o Right estará retornando o valore 12, pois retorna os 2 caracteres da direita para esquerda.
* Entendendo o código ( SelStart e SelText) If txt_vencimento.SelStart = 2 Then txt_vencimento.SelText = "/"
Significa que quando digitar o segundo caractere será inserido a /