[VB6] arrotondare orario ai 15 minuti superiori o inferiori

[donini]

Ciao a tutto il forum ho bisogno del vostro aiuto.
In un campo del database access sono riportati degli orari provenienti da un terminale badge, il mio problema è quando che richiamo questi orari vorrei che mi si arronda al quindici minuti superiori oppure ai 15 minuti inferiore
esempio
campo DB ora textbox
08,14 = 08,00
08,16 = 08,30
08, 33 = 08,30
08,48 = 09,00

è possibile fare tutto questo

[oregon]

Il campo dell'orario nel database di che tipo e'?

[donini]

il campo ora è di tipo orario breve

[LMondi]

Ciao Donini,
ritengo che il problema lo si può risolvere con Select Case; per quanto riguarda lo scatto del quarto d'ora, l'ho presunto solo dopo che sono trascorsi 7 minuti (1/2 di 15 circa) del secondo quarto d'ora. Qualora ciò non fosse nelle tue previsioni puoi modificare la seguenza di seguito esposta:

Option Explicit

Private Sub Command1_Click()
    Dim sCut As String
    Dim sDelta As String
    
    ' Restituisce due caratteri da destra:
        sCut = Right$(Text1.Text, 2)
        
    Select Case Ctr(sCut)
        Case Is < 15
            sDelta = "00"
        Case Is = 15
            sDelta = "15"
        Case 15 To 22
            sDelta = "15"
        Case 23 To 30
            sDelta = "30"
        Case 31 To 37
            sDelta = "30"
        Case 38 To 45
            sDelta = "45"
        Case 46 To 52
            sDelta = "45"
        Case 53 To 59
            sDelta = "1,00"
    End Select

    If Ctr(sCut) <= 52 Then
        ' Prende le ore e la virgola (tre caratteri da sinistra) ed aggiunge i minuti:
        Text2.Text = (Left$(Text1.Text, 3) & sDelta)
        ElseIf Ctr(sCut) >= 53 Then
        ' Prende le ore (due caratteri da sinistra) e somma un'ora:
        Text2.Text = Format((Ctr(Left$(Text1.Text, 2)) + Ctr(sDelta)), "#,##0.00")        
    End If
End Sub
'---------------------------------------------------------------------------------
Private Function Ctr(strTesto As String) As Double
    On Error Resume Next
        
    If IsNumeric(strTesto) = True Then
        Ctr = CDbl((strTesto))
        Else: Ctr = 0
    End If
    
End Function

E' importante che il formato ora sia del tipo: 08,25 - così come hai esposto, altrimenti dovrai apportare delle modifiche.

[donini]

SQL = ("SELECT * FROM ore WHERE ora Between #08:00# And #13:00# And(data='" & G1.Text & "/" & Mese.Text & "/" & Anno.Text & "' AND matricola= '" & matricola.Text & "' AND entusc= '" & "1000" & "')")
    Set rs = cn.Execute(SQL)
If Not rs.EOF Then
GME1.Text = rs("ora").Value
Else
GME1.Text = ""
End If

questo è il codice con il quale mi connetto al database e mi restituisce il codice riportato nella tabella esempio 08:49:00

SQL = ("SELECT * FROM ore WHERE ora Between #08:00# And #13:00# And(data='" & G1.Text & "/" & Mese.Text & "/" & Anno.Text & "' AND matricola= '" & matricola.Text & "' AND entusc= '" & "1000" & "')")
    Set rs = cn.Execute(SQL)
If Not rs.EOF Then
GME1.Text = rs("ora").Value
Else
GME1.Text = ""
End If
 sCut = Right$(GME1.Text, 2)
Select Case Ctr(sCut)
        Case Is < 15
            sDelta = "00"
        Case Is = 15
            sDelta = "15"
        Case 15 To 22
            sDelta = "15"
        Case 23 To 30
            sDelta = "30"
        Case 31 To 37
            sDelta = "30"
        Case 38 To 45
            sDelta = "45"
        Case 46 To 52
            sDelta = "45"
        Case 53 To 59
            sDelta = "1,00"
    End Select

    If Ctr(sCut) <= 52 Then
        ' Prende le ore e la virgola (tre caratteri da sinistra) ed aggiunge i minuti:
        GME1.Text = (Left$(GME1.Text, 3) & sDelta)
        ElseIf Ctr(sCut) >= 53 Then
        ' Prende le ore (due caratteri da sinistra) e somma un'ora:
        GME1.Text = Format((Ctr(Left$(GME1.Text, 2)) + Ctr(sDelta)), "#,##0.00")
    End If

rs.Close

inserendo il tuo codice in questo modo il programma mi da come risposta 00
mentre mi doveva riportare 09:00:00

[donini]

mi corrego il programma mi risponde 08:00

[chipdb]

Ciao, prova con questa funzione:

Private Function ApprossimaOrario(ByVal ora As Date, ByVal Approssimazione As Integer) As Date
    Dim I, ExitVal, Delta, DeltaMezzi As Integer
    
    'calcolo i delta di approssimazione
    Delta = Approssimazione * 2
    DeltaMezzi = Delta / 2
    
    'tengo salvati i minuti
    minuti = Minute(data)
    ExitVal = minuti
    
    'se non è multiplo di Delta allora devo arrotondare
    If Not minuti Mod Delta = 0 Then
        'percorro i 60 minuti di un'ora in base al dettaglio di approssimazione
        For I = Delta To 60 Step Delta
            If Minute(data) < (I - DeltaMezzi) Then
                ExitVal = I - Delta
                Exit For
            ElseIf Minute(data) > (I - DeltaMezzi) And Minute(data) < (I + DeltaMezzi) Then
                ExitVal = I
                Exit For
            End If
        Next I
        
        'il valore di uscita di I è ciò che deve rimanere dei minuti
        minuti = ExitVal
    End If
    
    'ritorno l'orario approssimato
    ApprossimaOrario = TimeSerial(ore, minuti, 0)
End Function

basta che gli passi l'orario e i minuti di approssimazione (quindi se devi approssimare come nel tuo caso di 15 minuti devi passargli il numero 15). Vedi se fa al caso tuo.

[donini]

come devo inserire questa funzione in una textbox

[chipdb]

SQL = ("SELECT * FROM ore WHERE ora Between #08:00# And #13:00# And(data='" & G1.Text & "/" & Mese.Text & "/" & Anno.Text & "' AND matricola= '" & matricola.Text & "' AND entusc= '" & "1000" & "')")
    Set rs = cn.Execute(SQL)
If Not rs.EOF Then
GME1.Text = ApprossimaOrario(cDate(rs("ora").Value), 15)
Else
GME1.Text = ""
End If

[LMondi]

Donini, se evidenzi un risultato

... esempio
campo DB ora textbox
08,14 = 08,00
08,16 = 08,30
....

su cui lavorare e poi affermi un'altra cosa, ...

...questo è il codice con il quale mi connetto al database e mi restituisce il codice riportato nella tabella esempio 08:49:00

allora con te è tempo perso.