🚀 go-pugleaf

"rinaffo" <rinaffo@libero.it> ha scritto nel messaggio
news:xhS%9.81230$YG2.2302393@twister1.libero.it...
> Come faccio a calcolare una data ?
> Ho una text con una data d'inizio , selezionando una opzione devo far si
che
> questa data aumenti a seconda dell'opzione scelta.
>
> es:    01\01\03   se scelgo  giornaliero la data diventera in una
> seconda text: 02\01\03
>          se scelgo settimanale diventera' 08\01\03
>
> grazie Rino.
>
Se ti pu� interessare, ecco un elenco di funzioni che mi sono creato per un
mio programmino che implementava un calendario perpetuo e moltissime altre
funzioni di calendario e per "giocare" un po' con le date:

Function Bisestile(ByVal Anno As Integer) As Boolean
   'Funzione che indica se un anno � bisestile oppure no
   '====================================================
    If Anno < 326 Then              'Calendario Giuliano
       Bisestile = (Anno Mod 4 = 0)
    ElseIf (Anno Mod 100 = 0) Then  'Calendario Gregoriano
           Bisestile = (Anno Mod 400 = 0) 'anno secolare
        Else
           Bisestile = (Anno Mod 4 = 0)   'anno non secolare
    End If
End Function

Function ConvertiCifreInData(ByVal GG As Integer, ByVal MM As Integer, ByVal
AA As Integer) As Date
   'Procedura che converte dei valori in un formato "Data"
    If GG < 10 Then
       D1$ = "0" & Trim$(Str$(GG))
    Else
       D1$ = Trim$(Str$(GG))
    End If
    If MM < 10 Then
       D2$ = "0" & Trim$(Str$(MM))
    Else
       D2$ = Trim$(Str$(MM))
    End If
    D3$ = Trim$(Str$(AA))
    D0$ = D2$ & "-" & D1$ & "-" & D3$
    ConvertiCifreInData = Format$(D0$, "dd-mm-yyyy")
End Function

Function DataValida(ByVal grn As Integer, ByVal mse As Integer, ByVal ANN As
Integer) As Boolean
  'Controlla la validit� di una data immessa
   Dim Risposta As Boolean
   Risposta = True
   If grn < 1 Or grn > GDM(mse, ANN) Then
      m$ = "Il giorno indicato � errato!"
      Risposta = False
   End If
   If mse < 1 Or mse > 12 Then
      m$ = "Il mese indicato � errato!"
      Risposta = False
   End If
   If ANN < 1583 Then
      m$ = "L'anno indicato � sbagliato oppure � antecedente al 1583"
      Risposta = False
   End If
   If Not Risposta Then MsgBox m$, vbOKOnly, "Data non valida!"
   DataValida = Risposta
End Function

Function GDA(ByVal Anno As Integer) As Integer
    'Calcolo dei Giorni Dell'Anno
     If Bisestile(Anno) Then
        GDA = 366
     Else
        GDA = 365
     End If
End Function

Function GDM(ByVal Mese As Integer, ByVal Anno As Integer) As Integer
   'Calcolo dei Giorni Del Mese
    Select Case Mese
       Case 2:  'Febbraio
              If Bisestile(Anno) Then
                   GDM = 29
              Else: GDM = 28
              End If
       Case 1, 3, 5, 7, 8, 10, 12: GDM = 31
       Case Else: GDM = 30
     End Select
End Function

Function GDSett(ByVal DD As Date) As Integer
   'Calcola il giorno della settimana corrispondente
   'alla data DD. GDSett restituisce un intero da 0 a 6,
   'dove 0 � Domenica, 1 Luned� e cos� via.
    Dim DRif As Date
    DD = Format$(DD, "dd-mm-yyyy")
    DRif = Format$("08-10-1972", "dd-mm-yyyy") 'Una Domenica di riferimento
    If DD > DRif Then
       GDSett = CLng(GTra(DRif, DD) Mod 7)
    Else
       J = GTra(DD, DRif)
       GDSett = CLng((7 - (GTra(DD, DRif) Mod 7)) Mod 7)
    End If
End Function

Function Giorno_Dopo(ByVal d As Date) As Date
 'Calcola la data successiva a quella immessa
  Dim G1, M1, A1 As Integer
  Dim G2, M2, A2 As Integer
  d = Format$(d, "dd-mm-yyyy")
  G1 = Day(d): M1 = Month(d): A1 = Year(d)
  If ((G1 = 31) And (M1 = 12)) Then
     A2 = A1 + 1
  Else
     A2 = A1
  End If
  Select Case M1
     Case 2: 'Febbraio
            Select Case G1
              Case 1 To 27:
                   G2 = G1 + 1
                   M2 = 2
              Case 28:
                   If Bisestile(A1) Then
                      G2 = 29
                      M2 = 2
                   Else
                      G2 = 1
                      M2 = 3
                   End If
              Case 29:
                      G2 = 1
                      M2 = 3
            End Select
       Case 12: 'Dicembre
            If G1 = 31 Then
               G2 = 1
               M2 = 1
            Else
               G2 = G1 + 1
               M2 = 12
            End If
       Case Else: 'Altri mesi
            If G1 = GDM(M1, A1) Then
               G2 = 1
               M2 = M1 + 1
            Else
               G2 = G1 + 1
               M2 = M1
            End If
     End Select
     Giorno_Dopo = ConvertiCifreInData(M2, G2, A2)
End Function

Function Giorno_Prima(ByVal d As Date) As Date
 'Calcola la data precedente a quella immessa
  Dim G1, M1, A1 As Integer
  Dim G2, M2, A2 As Integer
  d = Format$(d, "dd-mm-yyyy")
  G1 = Day(d): M1 = Month(d): A1 = Year(d)
  If ((G1 = 1) And (M1 = 1)) Then
     A2 = A1 - 1
  Else
     A2 = A1
  End If
  Select Case M1
     Case 1: 'Gennaio
            If G1 = 1 Then
               G2 = 31: M2 = 12
            Else
               G2 = G1 - 1: M2 = 1
            End If
     Case 3: 'Marzo
            If G1 = 1 Then
               If Bisestile(A1) Then G2 = 29 Else G2 = 28
               M2 = 2
            Else
               G2 = G1 - 1: M2 = 3
            End If
     Case Else: 'Altri mesi
            If G1 = 1 Then
               M2 = M1 - 1
               G2 = GDM(M2, A1)
            Else
               G2 = G1 - 1
               M2 = M1
            End If
     End Select
     Giorno_Prima = ConvertiCifreInData(M2, G2, A2)
End Function

Function GMFA(ByVal D0 As Date) As Integer
  'Calcola i Giorni Mancanti alla Fine dell'Anno della data D0
   Dim G1, M1, A1, g As Integer
   D0 = Format$(D0, "dd-mm-yyyy")
   G1 = Day(D0): M1 = Month(D0): A1 = Year(D0)
   If M1 = 12 Then
      GMFA = 31 - G1
   Else
      g = GDM(M1, A1) - G1
      For X = M1 + 1 To 12
      g = g + GDM(X, A1)
      Next X
      GMFA = g
   End If
End Function

Function GPIA(ByVal D0 As Date) As Integer
  'Calcola i Giorni Passati dall'Inizio dell'Anno della data D0
   Dim G1, M1, A1, g As Integer
   D0 = Format$(D0, "dd-mm-yyyy")
   G1 = Day(D0): M1 = Month(D0): A1 = Year(D0)
   If M1 = 1 Then
      GPIA = G1
   Else
      g = G1
      For K = M1 - 1 To 1 Step -1
      g = g + GDM(K, A1)
      Next K
      GPIA = g
   End If
End Function

Function GTra(ByVal D1 As Date, ByVal D2 As Date) As Long
   'Calcola i giorni che ci sono tra due date
   Dim g As Long
   Dim G1, M1, A1 As Integer
   Dim G2, M2, A2 As Integer
   D1 = Format$(D1, "dd-mm-yyyy")
   D2 = Format$(D2, "dd-mm-yyyy")
   G1 = Day(D1): M1 = Month(D1): A1 = Year(D1)
   G2 = Day(D2): M2 = Month(D2): A2 = Year(D2)
   If A2 = A1 Then
      GTra = GDA(A1) - (GPIA(D1) + GMFA(D2))
   ElseIf A2 = A1 + 1 Then
          GTra = GMFA(D1) + GPIA(D2)
       Else
          g = GMFA(D1) + GPIA(D2)
          For K = A1 + 1 To A2 - 1
          g = g + GDA(K)
          Next K
          GTra = g
   End If
End Function