Ayuda por favor con Fecha Juliana de 4 digitos!

[Bazooka]

Hola necesito una función que me devuelva la fecha juliana en 4 dígitos (SI O SI 4 DIGITOS).
Estoy utilizando esta pero no funciona bíen por que a veces me devuelve sólo 3 dígitos por ejemplo cuando le paso la fecha 28/01/2010.
Sería fácil completar con un cero adelante o atrás pero no creo que sea la solución correcta para ello.
Otra cosa es que tengo esta función para convertir a juliana pero no al revés para volverla a fecha por lo que no puedo probar su eficacia.

Este es el código:

Código: (vb) [Seleccionar]

Private Sub Command1_Click()
    Debug.Print Convert(Text1)
End Sub
'
Private Function Convert(fecha As String) As String
     Dim JdMon As String
'     Dim Tmonth As String
     Dim JdDay As String
     Dim JdYear As String
     Dim Jan As Integer
     Dim Feb As Integer
     Dim Mar As Integer
     Dim Apr As Integer
     Dim May As Integer
     Dim Jun As Integer
     Dim Jul As Integer
     Dim Aug As Integer
     Dim sep As Integer
     Dim Otb As Integer
     Dim Nov As Integer
     Dim Dec As Integer
     Dim JulianDate As String
     Dim LeapYears As String
     
     JdDay = Format$(Day(fecha), "00")
     JdMon = Format$(Month(fecha), "00")
     JdYear = Format$(Year(fecha), "0000")

     Jan = 31
     Feb = 28
     Mar = 31
     Apr = 30
     May = 31
     Jun = 30
     Jul = 31
     Aug = 31
     sep = 30
     Otb = 31
     Nov = 30
     Dec = 31
     LeapYears = DateSerial(JdYear, JdMon, JdDay)
'     Call LeapYear
     
     Select Case JdMon
          Case "01"  'jan
               JulianDate = JdDay
          Case "02"  'feb
               JulianDate = JdDay + Jan
          Case "03"  'mar
               JulianDate = JdDay + Jan + Feb
          Case "04"  'apr
               JulianDate = JdDay + Jan + Feb + Mar
          Case "05"  'may
               JulianDate = JdDay + Jan + Feb + Mar + Apr
          Case "06"  'jun
               JulianDate = JdDay + Jan + Feb + Mar + Apr + May
          Case "07"  'jul
               JulianDate = JdDay + Jan + Feb + Mar + Apr + May + Jun
          Case "08"  'aug
               JulianDate = JdDay + Jan + Feb + Mar + Apr + May + Jun + Jul
          Case "09"  'sep
               JulianDate = JdDay + Jan + Feb + Mar + Apr + May + Jun + Jul + Aug
          Case "10" 'oct
               JulianDate = JdDay + Jan + Feb + Mar + Apr + May + Jun + Jul + Aug + sep
          Case "11" 'nov
               JulianDate = JdDay + Jan + Feb + Mar + Apr + May + Jun + Jul + Aug + sep + Otb
          Case "12" 'dec
               JulianDate = JdDay + Jan + Feb + Mar + Apr + May + Jun + Jul + Aug + sep + Otb + Nov
     End Select
   
     Dim tmp
     tmp = JulianDate
     tmp = Right(JdYear, 1) & JulianDate
     Convert = tmp
     
End Function


P/D He visto muchas otras pero que devuelven 5 numeros y otras 6 pero en este caso tengo solo 4 espacios para insertar una fecha en un codigo de barras.

[wolf_kof]

Sinceramente no me agradas  pero encontre algo que talvez quieras leer

debes de usar la instrucción: DateDiff, en la ayuda del MSDN, encuentras lo siguiente:


DateDiff (Función)

Devuelve un valor de tipo Variant (Long) que especifica el número de intervalos de tiempo entre dos fechas determinadas.

Sintaxis

DateDiff(intervalo, fecha1, fecha2[, primerdíasemana[, primerasemanaaño]])

La sintaxis de la función DateDiff consta de los siguientesargumentos con nombre:

Parte Descripción
Intervalo Requerido.Expresión de tipo cadena con el intervalo de tiempo utilizado para calcular la diferencia entre fecha1 y fecha2.
Fecha1, fecha2 Requerido; Variant (Date). Las dos fechas que se van a utilizar en el cálculo.
Primerdíasemana Opcional.Constante que especifica el primer día de la semana. Si no se especifica, se asume que es el domingo.
Primerasemanaaño Opcional. Constante, que especifica la primera semana del año. Si no se especifica, se asume que es aquélla en la que se encuentre el 1 de enero.


Valores

Elargumento intervalo toma los valores siguientes:

Intervalo Descripción
yyyy Año
q Trimestre
m Mes
y Día del año
d Día
w Día de la semana
ww Semana
h Hora
n Minuto
s Segundo


El argumento primerdíasemana toma los siguientes valores:

Constante Valor Descripción
vbUseSystem 0 Utilice la configuración de la API de NLS.
vbSunday 1 Domingo (predeterminado)
vbMonday 2 Lunes
vbTuesday 3 Martes
vbWednesday 4 Miércoles
vbThursday 5 Jueves
vbFriday 6 Viernes
vbSaturday 7 Sábado

Constante Valor Descripción
vbUseSystem 0 Utilice la configuración de la API de NLS.
vbFirstJan1 1 Empieza con la semana en la que se encuentra el 1 de enero (predeterminado).
vbFirstFourDays 2 Empieza con la primera semana que tenga al menos cuatro días en el nuevo año.
vbFirstFullWeek 3 Empieza con la primera semana que esté completamente incluida en el nuevo año.


Comentarios

Puede utilizar la función DateDiff para determinar el número de intervalos especificados que existen entre dos fechas. Por ejemplo, con DateDiff podría calcular el número de días entre dos fechas o el número de semanas entre hoy y el final del año.

Si desea saber el número de días entre fecha1 y fecha2, puede utilizar Día del año ("y") o Día ("d"). Cuando intervalo es Día de la semana ("w"), DateDiff devuelve el número de semanas entre las dos fechas. Si fecha1 es lunes, DateDiff contará el número de lunes hasta fecha2. En la cuenta incluirá fecha2, pero no fecha1. Si intervalo es Semana ("ww"), la función DateDiff devolverá el número de semanas entre las dos fechas. En este caso contará el número de domingos entre fecha1 y fecha2. DateDiff contará fecha2 si es domingo, pero no fecha1, aunque sea domingo.

Si fecha1 se refiere a un momento posterior en el tiempo a fecha2, la función DateDiff devolverá un número negativo.

El argumento primerdíasemana afecta a los cálculos que utilizan "w" y "ww" como símbolos de intervalo.

Si fecha1 o fecha2 es unliteral de fecha, el año, si se especifica, pasará a ser una parte permanente de la fecha. Sin embargo, si fecha1 o fecha2 está comprendida entre comillas dobles ("") y se omite el año, se insertará el año en curso en el código cada vez que se evalúe la expresión fecha1 o fecha2. Así es posible escribir código que se pueda usar en años distintos.

Cuando compara el 31 de diciembre con el 1 de enero del año siguiente, DateDiff para un año ("yyyy") devolverá 1 aunque sólo haya pasado un día.

[Psyke1]

@MIKE
Como que en 4 digitos?
La conversion de 12/10/12 seria igual que la de 12/10/62...

Código: (vb) [Seleccionar]

Option Explicit

Private Function CJulian(ByVal myDate As Date) As String
    CJulian = Format$(myDate, "yy") & Format$((myDate - DateValue("1/1/" & Year(myDate)) + 1), "000")
End Function

Private Sub Command1_Click()
    Debug.Print CJulian(CDate(Text1.Text))
End Sub
DoEvents!

[Bazooka]

Sinceramente no me agradas  pero encontre algo que talvez quieras leer

debes de usar la instrucción: DateDiff, en la ayuda del MSDN, encuentras lo siguiente:


DateDiff (Función)

Devuelve un valor de tipo Variant (Long) que especifica el número de intervalos de tiempo entre dos fechas determinadas.

Sintaxis

DateDiff(intervalo, fecha1, fecha2[, primerdíasemana[, primerasemanaaño]])

La sintaxis de la función DateDiff consta de los siguientesargumentos con nombre:

Parte Descripción
Intervalo Requerido.Expresión de tipo cadena con el intervalo de tiempo utilizado para calcular la diferencia entre fecha1 y fecha2.
Fecha1, fecha2 Requerido; Variant (Date). Las dos fechas que se van a utilizar en el cálculo.
Primerdíasemana Opcional.Constante que especifica el primer día de la semana. Si no se especifica, se asume que es el domingo.
Primerasemanaaño Opcional. Constante, que especifica la primera semana del año. Si no se especifica, se asume que es aquélla en la que se encuentre el 1 de enero.


Valores

Elargumento intervalo toma los valores siguientes:

Intervalo Descripción
yyyy Año
q Trimestre
m Mes
y Día del año
d Día
w Día de la semana
ww Semana
h Hora
n Minuto
s Segundo


El argumento primerdíasemana toma los siguientes valores:

Constante Valor Descripción
vbUseSystem 0 Utilice la configuración de la API de NLS.
vbSunday 1 Domingo (predeterminado)
vbMonday 2 Lunes
vbTuesday 3 Martes
vbWednesday 4 Miércoles
vbThursday 5 Jueves
vbFriday 6 Viernes
vbSaturday 7 Sábado

Constante Valor Descripción
vbUseSystem 0 Utilice la configuración de la API de NLS.
vbFirstJan1 1 Empieza con la semana en la que se encuentra el 1 de enero (predeterminado).
vbFirstFourDays 2 Empieza con la primera semana que tenga al menos cuatro días en el nuevo año.
vbFirstFullWeek 3 Empieza con la primera semana que esté completamente incluida en el nuevo año.


Comentarios

Puede utilizar la función DateDiff para determinar el número de intervalos especificados que existen entre dos fechas. Por ejemplo, con DateDiff podría calcular el número de días entre dos fechas o el número de semanas entre hoy y el final del año.

Si desea saber el número de días entre fecha1 y fecha2, puede utilizar Día del año ("y") o Día ("d"). Cuando intervalo es Día de la semana ("w"), DateDiff devuelve el número de semanas entre las dos fechas. Si fecha1 es lunes, DateDiff contará el número de lunes hasta fecha2. En la cuenta incluirá fecha2, pero no fecha1. Si intervalo es Semana ("ww"), la función DateDiff devolverá el número de semanas entre las dos fechas. En este caso contará el número de domingos entre fecha1 y fecha2. DateDiff contará fecha2 si es domingo, pero no fecha1, aunque sea domingo.

Si fecha1 se refiere a un momento posterior en el tiempo a fecha2, la función DateDiff devolverá un número negativo.

El argumento primerdíasemana afecta a los cálculos que utilizan "w" y "ww" como símbolos de intervalo.

Si fecha1 o fecha2 es unliteral de fecha, el año, si se especifica, pasará a ser una parte permanente de la fecha. Sin embargo, si fecha1 o fecha2 está comprendida entre comillas dobles ("") y se omite el año, se insertará el año en curso en el código cada vez que se evalúe la expresión fecha1 o fecha2. Así es posible escribir código que se pueda usar en años distintos.

Cuando compara el 31 de diciembre con el 1 de enero del año siguiente, DateDiff para un año ("yyyy") devolverá 1 aunque sólo haya pasado un día.

Gracias y lamento no agradarte te creaste de mi una idea que nada que ver, muy completo tu aporte! estuve provando pero no encuentro la manera por que en realidad no tengo que calcular ninguna fecha sino convertir una fecha desde este formato 10/12/2010  a este 0344 y luego viceversa al leer el codigo de barras extraer los 4 digitos (0344) y convertir la fecha al formato 10/12/2010

[Bazooka]

@MIKE
Como que en 4 digitos?
La conversion de 12/10/12 seria igual que la de 12/10/62...

Código: (vb) [Seleccionar]

Option Explicit

Private Function CJulian(ByVal myDate As Date) As String
    CJulian = Format$(myDate, "yy") & Format$((myDate - DateValue("1/1/" & Year(myDate)) + 1), "000")
End Function

Private Sub Command1_Click()
    Debug.Print CJulian(CDate(Text1.Text))
End Sub
DoEvents!

Si 4 digitos!  10/12/2010 seria >>> 0344 (4 digitos) Y no es un capricho estoy en busca de ese algoritmo por que la exigencia de mi cliente es que la fecha solo tenga 4 digitos segun el calendario juliano (http://es.wikipedia.org/wiki/Fecha_juliana)

Y respecto a tu aporte de acortar la función está perfecto por lo menos con algunas pruebas que le hice sólo que  me devuelve la fecha en 5 digitos.
Estoy comenzando a dudar que se pueda representar la fecha en 4 digitos hoy domingo llevo buscando 3 horas y me estoy ..........
Cualquier novedad la voy a informar para que quede registrado.

[LeandroA]

por lo que yo veo eso al hacer la reversa no hay forma de calcular el año solo si se comprende que ablamos de una decada en comun. vos solo pones el primer dijito del año por lo cual al revertir la funcion no te nunca vas a saber el año exacto.

Estas seguro que ese metodo esta bien? mas aya de que sean 5 o 4 dijitos?

[Psyke1]

.
Hasta ahora todas las fechas Julianas que he visto eran de 5 digitos, pero bueno...
Basado en tu funcion te dejo la mia simplificada al maximo(incluye comprobacion de año bisiesto y el problema que tenias conl os ceros):

Código: (vb) [Seleccionar]

Option Explicit

Private Function CJulian4(ByVal MyDate As Date) As String
    CJulian4 = Right$(CStr(Year(MyDate)), 1) & IIf(CLng(Day(MyDate)) < 10, "0", vbNullString) & CStr(CLng(Day(MyDate)) + IIf((Day(DateSerial(Year(MyDate), 2, 29)) = 29), 1, 0) + Choose(CLng(Month(MyDate)), 31, 59, 90, 120, 151, 181, 212, 242, 273, 303, 333, 364))
End Function

Private Sub Command1_Click()
    Debug.Print CJulian4(CDate(Text1.Text))
End Sub
DoEvents!

[kennylop]

amigo bueno es un poco confuso de entender de forma sinplificada la verdad y una solucion un poco tirada de mi parte esta aqui, solo la primera parte la segunda ya es tarea tuya, te daras cuenta que saco dos tipos de dato para el anio y es para poder almacenar en la base de datos esto y luego poder pasar de juliana a normal ok, adjunto link para que veas.

http://rapidshare.com/files/435158241/datejuliana.rar

espero serte de ayuda amigo

Código: [Seleccionar]

Private Sub cmdCommand1_Click()
Call julian
End Sub

Private Sub d1_Change()
On Error Resume Next
t1.Text = d1.Value
End Sub

Private Sub Form_Load()
t1.Text = d1.Value
End Sub

Public Sub julian()
Dim jdday, jdmon, jdyear, jdyearreal, juliandate

'leemos desde la caja de texto y no del dtpicker

jdday = Mid$(t1.Text, 1, 2)
jdmon = Mid$(t1.Text, 4, 2)
jdyear = Mid$(t1.Text, 10, 2)
jdyearreal = Mid$(t1.Text, 9, 2)


     Jan = 31
     Feb = 28
     Mar = 31
     Apr = 30
     May = 31
     Jun = 30
     jul = 31
     Aug = 31
     sep = 30
     Otb = 31
     Nov = 30
     Dec = 31
     
     'limpiamos la valiable
     
     juliandate = 0
   
Select Case jdmon
          Case "01"  'jan
              juliandate = jdday
          Case "02"  'feb
              juliandate = jdday + Jan
          Case "03"  'mar
              juliandate = jdday + Jan + Feb
          Case "04"  'apr
              juliandate = jdday + Jan + Feb + Mar
          Case "05"  'may
              juliandate = jdday + Jan + Feb + Mar + Apr
          Case "06"  'jun
              juliandate = jdday + Jan + Feb + Mar + Apr + May
          Case "07"  'jul
              juliandate = jdday + Jan + Feb + Mar + Apr + May + Jun
          Case "08"  'aug
              juliandate = jdday + Jan + Feb + Mar + Apr + May + Jun + jul
          Case "09"  'sep
              juliandate = jdday + Jan + Feb + Mar + Apr + May + Jun + jul + Aug
          Case "10" 'oct
              juliandate = jdday + Jan + Feb + Mar + Apr + May + Jun + jul + Aug + sep
          Case "11" 'nov
              juliandate = jdday + Jan + Feb + Mar + Apr + May + Jun + jul + Aug + sep + Otb
          Case "12" 'dec
              juliandate = jdday + Jan + Feb + Mar + Apr + May + Jun + jul + Aug + sep + Otb + Nov
     End Select

´formateamos el dato a nuestra necesidad en este caso 4 digitos

juliandate = jdyear + Format(juliandate, "000")
MsgBox juliandate
End Sub


[cobein]

http://media.skyandtelescope.com/binary/caljd.bas
http://media.skyandtelescope.com/binary/jdcal.bas

Estan en basic pero no es muy difical convertirlos.

[Bazooka]

Huy gracias cuantas respuesta! ahora me pongo a mirar todo y posteo luego la solucion!!

Gracias muchachos!

[Bazooka]

Hola a todos!

Para el que le interese solucioné el problema al fin!!
El tema de la fecha JULIANA que necesitaba representar en 4 Digitos es así el primer basándome en la fecha de hoy 07/12/2010 y transformada a 4 dígitos es 0341 , el 1º dígito (0) representa al año 2010 y los otros 3 restantes son los días trascurridos desde el 1º de enero o sea que hoy está transcurriendo el dia 341.
Uno puede pensar que el 0  que representa al año 2010 podría interpretarse como por ejemplo el año 2000 lo que si se utiliza la rutina que abajo coloco da exactamente el mismo numero 07/12/2000 = 0341 . Pero el sistema que lee estos números se actualiza cada 10 años y no lee hacia atrás.

Bueno tal vezz algunos no me entiendan por que se trata de un desarrollo especifico que me solicitaron pero si a alguien le sirve pongo abajo el codigo completo que devuelve los 4 digitos de la fecha pasada como parámetro.

Código: (vb) [Seleccionar]

Private Function Convert(fecha As String) As String
     Dim JdMes As String
     Dim JdDia As String
     Dim JdAño As String
     Dim ENE As Integer
     Dim FEB As Integer
     Dim MAR As Integer
     Dim ABR As Integer
     Dim MAY As Integer
     Dim JUN As Integer
     Dim JUL As Integer
     Dim AGO As Integer
     Dim SEP As Integer
     Dim OCT As Integer
     Dim NOV As Integer
     Dim DIC As Integer
     Dim JulianDate As String
     Dim LeapYears As String
     
     JdDia = Format$(Day(fecha), "00")
     JdMes = Format$(Month(fecha), "00")
     JdAño = Format$(Year(fecha), "0000")

     ENE = 31
     
     'COMPROBACION DE AÑO BICIESTO
     If Comprobar(JdAño) Then
        FEB = 29
     Else
        FEB = 28
     End If
     '
     MAR = 31
     ABR = 30
     MAY = 31
     JUN = 30
     JUL = 31
     AGO = 31
     SEP = 30
     OCT = 31
     NOV = 30
     DIC = 31
     
     LeapYears = DateSerial(JdAño, JdMes, JdDia)
     
     Select Case JdMes
          Case "01"  'ENE
               JulianDate = JdDia
          Case "02"  'FEB
               JulianDate = JdDia + ENE
          Case "03"  'MAR
               JulianDate = JdDia + ENE + FEB
          Case "04"  'ABR
               JulianDate = JdDia + ENE + FEB + MAR
          Case "05"  'MAY
               JulianDate = JdDia + ENE + FEB + MAR + ABR
          Case "06"  'JUN
               JulianDate = JdDia + ENE + FEB + MAR + ABR + MAY
          Case "07"  'JUL
               JulianDate = JdDia + ENE + FEB + MAR + ABR + MAY + JUN
          Case "08"  'AGO
               JulianDate = JdDia + ENE + FEB + MAR + ABR + MAY + JUN + JUL
          Case "09"  'SEP
               JulianDate = JdDia + ENE + FEB + MAR + ABR + MAY + JUN + JUL + AGO
          Case "10" 'oct
               JulianDate = JdDia + ENE + FEB + MAR + ABR + MAY + JUN + JUL + AGO + SEP
          Case "11" 'NOV
               JulianDate = JdDia + ENE + FEB + MAR + ABR + MAY + JUN + JUL + AGO + SEP + OCT
          Case "12" 'DIC
               JulianDate = JdDia + ENE + FEB + MAR + ABR + MAY + JUN + JUL + AGO + SEP + OCT + NOV
     End Select
   
     Dim tmp
     tmp = JulianDate
     tmp = Right(JdAño, 1) & JulianDate
     Convert = Right$("0000" & tmp, 4)
     
End Function

' función que comprueba si el año es bisiesto
'''''''''''''''''''''''''''''''''''''''''''''
Public Function Comprobar(Año As Variant) As Boolean
   
    If VarType(Año) = vbDate Then
        Comprobar = (Day(DateSerial(Year(Año), 2, 29)) = 29)
    Else
        Comprobar = (Day(DateSerial(Año, 2, 29)) = 29)
    End If
End Function
Muchas gracias a todos los que me ayudaron!!

[LeandroA]

Hola yo creo que entre lo que te dijo wolf_kof y algo de lo que puso Mr. Frog podrias resumir toda esa función en una linea

Código: [Seleccionar]

Private Function FechaJuliana(ByVal Fecha As Date) As String
    FechaJuliana = Right$(Year(Fecha), 1) & Format$(DateDiff("D", "01/01/" & Year(Fecha), Fecha) + 1, "000")
End Function
Saludos.

[Bazooka]

Hola yo creo que entre lo que te dijo wolf_kof y algo de lo que puso Mr. Frog podrias resumir toda esa función en una linea

Código: [Seleccionar]

Private Function FechaJuliana(ByVal Fecha As Date) As String
    FechaJuliana = Right$(Year(Fecha), 1) & Format$(DateDiff("D", "01/01/" & Year(Fecha), Fecha) + 1, "000")
End Function
Saludos.

Cierto Leandro lo que pasa es que en al apuro por concluir esto me habia dlo deje asi nomas como la tenia pero ya esta cambiada por la simplificada al maximo!  .
De nuevo gracias a todos