Archief - Check: VBA code

Het archief is een bevroren moment uit een vorige versie van dit forum, met andere regels en andere bazen. Deze posts weerspiegelen op geen enkele manier onze huidige ideeën, waarden of wereldbeelden en zijn op sommige plaatsen gecensureerd wegens ontoelaatbaar. Veel zijn in een andere tijdsgeest gemaakt, al dan niet ironisch - zoals in het ironische subforum Off-Topic - en zouden op dit moment niet meer gepost (mogen) worden. Toch bieden we dit archief nog graag aan als informatiedatabank en naslagwerk. Lees er hier meer over of start een gesprek met anderen.
W

Wover

Legacy Member
Yow, k eb ier ff een progje geschreven om het aantal dagen en maanden tot de verjaardag van crew van mijn gamessite te berekenen. Ge zult zien dat ik in het eerste deel moeite heb gedaan om rekening te houden met maanden die 31 of 30 dagen duren (screw februari :p), maar in het 2e deel (waar de verjaardag nog niet gepasseerd is dit jaar), hebbek gewoon snel wa geschreven om het prog uit te testen. Nu, wss zitten daar al fouten in, maar er zit begot ook al een fout in de do constructie. De fout is: Loop zonder Do, maar zoals ge zult zien is da allemaal perfect conform de regelkes :p

Code: 
Option Compare Database
Option Explicit


Public Sub TijdTotVerjaardag()

Dim rsCrew As New ADODB.Recordset
Dim intAantalMaanden As Integer
Dim intAantalDagen As Integer

rsCrew.Open "tblCrewmembers", CurrentProject.Connection

Do While rsCrew.EOF = False
    If Date - rsCrew!Geboortedatum > 0 Then
        intAantalMaanden = 12 - Month(Date) + Month(rsCrew!Geboortedatum)
        If Month(Date) = 1 Or Month(Date) = 3 Or Month(Date) = 5 Or Month(Date) = 7 Or Month(Date) = 8 Or Month(Date) = 10 Or Month(Date) = 12 Then
            intAantalDagen = 31 - Day(rsCrew!Geboortedatum) + 30 * (Month(Date) - Month(rsCrew!Geboortedaum) + Month(rsCrew!Geboortedatum))
        Else
        If Month(Date) = 2 Or Month(Date) = 4 Or Month(Date) = 6 Or Month(Date) = 9 Or Month(Date) = 11 Then
            intAantalDagen = 30 - Day(rsCrew!Geboortedatum) + 30 * (Month(Date) - Month(rsCrew!Geboortedaum) + Month(rsCrew!Geboortedatum))
        End If
    Debug.Print rsCrew!Membername, Tab(10), intAantalMaanden, Tab(15), intAantalDagen
    If Date - rsCrew!Geboortedatum < 0 Then
        intAantalMaanden = Month(rsCrew!Geboortedatum) - Month(Date)
        intAantalDagen = intAantalMaanden * 30
    End If
    Debug.Print rsCrew!Membername, Tab(10), intAantalMaanden, Tab(15), intAantalDagen
Loop
    
End Sub
[

[IpL]Viper_666

Legacy Member
Heb hier agou iets in elkaar gestoken maar het werkt met het aantal dagen en ni maanden/dagen.

Code: 
Public Sub TijdTotVerjaardag()

        Dim rsCrew As New ADODB.Recordset
        Dim intAantalMaanden As Integer
        Dim intAantalDagen As Integer

        rsCrew.Open("tblCrewmembers", Connection)

        Do While rsCrew.EOF = False
            Debug.Print(rsCrew!Membername, TAB(10), GeefVerjaardagInfo(rsCrew!Geboortedatum))
        Loop

    End Sub

    Public Function GeefVerjaardagInfo(ByVal GeboorteDatum As Date) As String

        Dim intAantalDagen As Integer
        Dim strMessage As String

        intAantalDagen = VerschilInDagen(GeboorteDatum.Month, GeboorteDatum.Day)

        If intAantalDagen = 0 Then
            strMessage = "Vandaag"
        ElseIf intAantalDagen < 0 Then
            strMessage = "Al " + Math.Abs(intAantalDagen).ToString() + " dagen geleden"
        Else : strMessage = "Nog " + intAantalDagen.ToString() + "dagen"
        End If

        Return strMessage

    End Function

    Public Function VerschilInDagen(ByVal Maand As Integer, ByVal Dag As Integer) As Integer

        Dim tsVerschil As TimeSpan

        tsVerschil = New DateTime(DateTime.Today.Year, Maand, Dag).Subtract(DateTime.Today)

        Return tsVerschil.Days

    End Function
Als je echt het aantal maanden wil, moet is je in die functie waar het verschil wordt berkend gaan zien.
Je kan zo een nieuw Date object maken met dat verschil :
Code: 
Dim dtVerscil As Date = New DateTime(tsVerschil.Ticks)
Je moet dan wel controleren of je verschil wel positief is (negatieve Date kan niet) en wanneer je dan
de maand of de dag opvraagt uit die Date dan zit je nog is met het probleem dat de minimum waarde
voor dag maand en jaar 1 is, dus moet je dat er weer aftrekken.

Succes dermee.
W

Wover

Legacy Member
ik zal het dan maar op het aantal dagen houden :)

bedankt voor de reply, ik vreesde al dat niemand de uberleet taal vba kende :p :ironic:
W

Wover

Legacy Member
k eb uw code eens gecopy paste, maar die geeft een aantal errors, daarom deze vragen:

-welk prog gebruikt ge?
-heb je misschien extra libraries geïnstalleerd ofzo.

Hij geeft fouten bij:

Debug.Print(rsCrew!Membername, TAB(10), GeefVerjaardagInfo(rsCrew!Geboortedatum))


Return strMessage
W

Wover

Legacy Member
ik heb return strMessage in GoTo strMessage verandert en alle andere fouten aangepast, maar ik begrijp ni wa ge bedoelt met "ByVal GeboorteDatum As Date"

want hier geeft hij fouten op. Welke waarde moete hierbij invullen bij uitvoeren?
Het archief is een bevroren moment uit een vorige versie van dit forum, met andere regels en andere bazen. Deze posts weerspiegelen op geen enkele manier onze huidige ideeën, waarden of wereldbeelden en zijn op sommige plaatsen gecensureerd wegens ontoelaatbaar. Veel zijn in een andere tijdsgeest gemaakt, al dan niet ironisch - zoals in het ironische subforum Off-Topic - en zouden op dit moment niet meer gepost (mogen) worden. Toch bieden we dit archief nog graag aan als informatiedatabank en naslagwerk. Lees er hier meer over of start een gesprek met anderen.
Terug
Bovenaan