|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (Datas/Números/Strings)
|
|
 |
Título da Dica: Diversas funções para cálculos com datas.
|
 |
|
|
|
Postada em 28/12/2003 por PC
Cole isto em um FORM
Private Sub Form_Load()
Print "126 minutos são :"
Print CStr(Module1.DeMinutos(126)) & " horas"
Print
Print "3:02 são "
Print Module1.ParaMinutos(CDate("3:02")) & " minutos."
Print
Print "Fazem " & Module1.Intervalo(CDate("08/05/1945"), Date, shAno) & " anos ou mais precisamente " & Module1.Intervalo(CDate("08/05/1945"), Date, shMes) & " meses do fim da 2º guerra."
Print
Print "Hoje mais 15 dias será o dia " & Module1.SomaData(shDia, 15, Agora)
Print "Agora mais 15 minutos será " & Module1.SomaData(shMinuto, 15, Agora)
Print "Hoje menos 15 dias foi o dia " & Module1.SubtraiData(shDia, 15, Agora)
Print "Agora menos 15 minutos foi " & Module1.SubtraiData(shMinuto, 15, Agora)
Print "Data curta " & Formatar(Agora, DataCurta)
Print "Data longa " & Formatar(Agora, DataLonga)
Print "Data padra " & Formatar(Agora, DataPadrao)
Print "Data super " & Formatar(Agora, DataSuperLonga)
Print "Hora curta " & Formatar(Agora, HoraCurta)
Print "Hora longa " & Formatar(Agora, HoraLonga)
Print
Print "Hoje é " & Module1.DiaDaSemana(Agora)
End Sub
'E cole istoe m um module chamado MODULE1
Enum TipoDeData
shSegundo = 0 '"s"
shMinuto = 1 '"n"
shHora = 2 '"h"
shDia = 3 '"d"
shMes = 4 '"m"
shAno = 5 '"y"
End Enum
Enum FormatosData
HoraCurta = 0
HoraLonga = 1
DataCurta = 2
DataPadrao = 3
DataLonga = 4
DataSuperLonga = 5
DataHora = 6
End Enum
Function DiaDaSemana(Dia As Date, Optional Abrevia As Boolean = False) As String
If Abrevia = False Then
Select Case Weekday(Dia)
Case Is = 1
DiaDaSemana = "Domingo"
Case Is = 2
DiaDaSemana = "Segunda"
Case Is = 3
DiaDaSemana = "Terça"
Case Is = 4
DiaDaSemana = "Quarta"
Case Is = 5
DiaDaSemana = "Quinta"
Case Is = 6
DiaDaSemana = "Sexta"
Case Is = 7
DiaDaSemana = "Sábado"
End Select
Else
Select Case Weekday(Dia)
Case Is = 1
DiaDaSemana = "Dom"
Case Is = 2
DiaDaSemana = "Seg"
Case Is = 3
DiaDaSemana = "Ter"
Case Is = 4
DiaDaSemana = "Qua"
Case Is = 5
DiaDaSemana = "Qui"
Case Is = 6
DiaDaSemana = "Sex"
Case Is = 7
DiaDaSemana = "Sáb"
End Select
End If
End Function
Function Formatar(aData As Date, oFormato As FormatosData) As Variant
If oFormato = 4 Then
Formatar = Format$(aData, "dd ") & "de " & Format$(CStr(aData), "mmmm ") & "de " & Format$(aData, "yyyy")
ElseIf oFormato = 5 Then
Formatar = Format$(aData, "dddd, ") & Format$(aData, "dd ") & "de " & Format$(CStr(aData), "mmmm ") & "de " & Format$(aData, "yyyy")
Else
Formatar = CDate(Format$(aData, RetVrD(oFormato)))
End If
End Function
Function Agora(Optional oFormato As FormatosData = DataHora) As Variant
If oFormato = 4 Then
Agora = Format$(Now, "dd ") & "de " & Format$(CStr(Now), "mmmm ") & "de " & Format$(Now, "yyyy")
ElseIf oFormato = 5 Then
Agora = Format$(Now, "dddd, ") & Format$(Now, "dd ") & "de " & Format$(CStr(aData), "mmmm ") & "de " & Format$(Now, "yyyy")
Else
Agora = CDate(Format$(Now, RetVrD(oFormato)))
End If
End Function
Private Function RetVrD(Vat) As String
If Vat = 0 Then RetVrD = "Hh:Nn:Ss"
If Vat = 1 Then RetVrD = "Hh:Nn:Ss AM/PM"
If Vat = 2 Then RetVrD = "dd/mm/yy"
If Vat = 3 Then RetVrD = "dd/mm/yyyy"
If Vat = 4 Then RetVrD = "ddd mmm yyyy"
If Vat = 5 Then RetVrD = "dddd mmmm yyyy"
If Vat = 6 Then RetVrD = "Dd/Mm/yyyy Hh:Nn:Ss"
End Function
Private Function RetVr(Vat) As String
If Vat = 0 Then RetVr = "s"
If Vat = 1 Then RetVr = "n"
If Vat = 2 Then RetVr = "h"
If Vat = 3 Then RetVr = "d"
If Vat = 4 Then RetVr = "m"
If Vat = 5 Then RetVr = "yyyy"
End Function
Public Function DeMinutos(Minutos As Integer) As Date
Dim Tmp As Integer
If Minutos <= 0 Then
DeMinutos = CDate("00:00:00")
Else
Tmp = (Minutos / 60)
DeMinutos = CDate(CStr(Tmp) & ":" & (Minutos Mod 60))
End If
End Function
'Esta Função me retorna quantos seg, mes dia... tem desde a data X a Y
Public Function Intervalo(DataInicial As Date, DataFinal As Date, EmQue As TipoDeData) As Double
On Error Resume Next
Intervalo = DateDiff(RetVr(EmQue), DataInicial, DataFinal)
End Function
'Esta function pega uma hora e transfoma em minutos desde a 00:00
Public Function ParaMinutos(Hora As Date) As Double
On Error Resume Next
ParaMinutos = (Format(Hora, "hh") * 60) + (Format(Hora, "mm"))
End Function
'Esta funççao soma um um uemro de dias horas... as uma data
Public Function SomaData(Tipo As TipoDeData, Quanto As Double, aData As Date) As Date
On Error Resume Next
SomaData = DateAdd(RetVr(Tipo), Quanto, aData)
End Function
'Esta funççao subtrai um um uemro de dias horas... as uma data
Public Function SubtraiData(Tipo As TipoDeData, Quanto As Double, aData As Date) As Date
On Error Resume Next
SubtraiData = DateAdd(RetVr(Tipo), Quanto * -1, aData)
End Function
|
|
|
|
|
