Imprimir página | Cerrar ventana

VBA: Fechas. Suma Tiempos

Impreso de: Foro de Access y VBA
Categoría: Access y VBA
Nombre del foro: Tus Funciones Favoritas & Aportaciones & Artí­culos
Descripción del foro: Para publicar código interesante, aportaciones y artículos
URL: http://www.mvp-access.com/foro/forum_posts.asp?TID=77379
Fecha de impresión: 20/Septiembre/2020 a las 07:38


Tema: VBA: Fechas. Suma Tiempos
Publicado por: genoma111
Asunto: VBA: Fechas. Suma Tiempos
Fecha de publicación: 20/Agosto/2013 a las 22:28
DateAdd no puede sumar fracciones, y muchas veces eso es precisamente lo que necesitamos.

Para suplir esa necesidad he construido esta función.

Uso:

Private Sub Command0_Click()
' Por ejemplo si queremos sumar 1 año y una semana a la fecha actual

MsgBox Now() & vbNewLine & DateAdds(Now(), 1, , , 1)

End Sub

Función:

'---------------------------------------------------------------------------------------------------------------------------------------
' Nombre:       DateAdds
' Propósito:    Suma Fechas/Horas usando la función DateAdd supliendo la incapacidad de DateAdd para sumar fracciones.
'               Todos los parámetros excepto "Date1" son opcionales.
' Descripción:  Date1:      Fecha Inicial.
'               Years:      Años.
'               Quarters:   Trimestres.
'               Months:     Meses
'               Weeks:      Semanas
'               Days:       Días
'               Hours:      Horas
'               Minutes:    Minutos
'               Seconds:    Segundos
'
' Author:       Diego F.Pereira-Perdomo
'
' Date:         May-29-2013
'---------------------------------------------------------------------------------------------------------------------------------------
Public Function DateAdds(Date1 As Date, _
                Optional Years As Long, _
             Optional Quarters As Long, _
               Optional Months As Long, _
                Optional Weeks As Long, _
                 Optional Days As Long, _
                Optional Hours As Long, _
              Optional Minutes As Long, _
              Optional Seconds As Long) As Date
             
    Dim Date2 As Date
   
    Date2 = Date1
   
    If Years Then: Date2 = DateAdd("yyyy", Years, Date2)
    If Quarters Then: Date2 = DateAdd("q", Quarters, Date2)
    If Months Then: Date2 = DateAdd("m", Months, Date2)
    If Weeks Then: Date2 = DateAdd("ww", Weeks, Date2)
    If Days Then: Date2 = DateAdd("d", Days, Date2)
    If Hours Then: Date2 = DateAdd("h", Hours, Date2)
    If Minutes Then: Date2 = DateAdd("n", Minutes, Date2)
    If Seconds Then: Date2 = DateAdd("s", Seconds, Date2)
   
    DateAdds = Date2
End Function



-------------
"To VBA or not to VBA... that's the question" DFP



Imprimir página | Cerrar ventana