Zwangerschapsduur berekenen in VBA

[Nicu]

Ik heb een sheet waarbij ik de zwangerschapsduur wil berekenen, dit zijn de aantal dagen dat een kind geboren is, opgeteld bij de zwangerschapsduur. Dit moet in VBA omdat ik ook een script heb om kinderen te verplaatsen. Bij de sheet heb ik meer uitleg gezet, hoop dat dit duidelijk is. Ik hoop dat it mogelijk is....

 

[Warme bakkertje]

De berekening op zich is eenvoudig, de vraag is enkel hoe je dit gaat implementeren aangezien ik veronderstel dat je dit in meerdere vakken wil gaan gebruiken.

Sub tst()
    wks = DateDiff("w", Range("B15"), Date, 2)
    dys = DateDiff("d", Range("B15"), Date, 2) Mod 7
    trm = Split(Range("B16"), "+")
    Range("C15") = wks & " wkn " & dys & " dgn"
    Range("B17") = "nu " & trm(0) + wks & "+" & trm(1)
End Sub

 

[Cobbe]

Test deze eens - selecteer een datumveld bv B9

 

[Warme bakkertje]

Een beetje gestroomlijnd zodat er geen waarden v/h werkblad moeten gelezen worden om de berekeningen te maken.

Private Sub plaats(x)
    With Kalender
        c2 = CDate("01-" & Month(CDate(.Tag)) & "-" & Year(CDate(.Tag)))
        c1 = c2 - (Int(Day(c2) / 7) * 7) - Weekday(c2, vbMonday) + x
        c0 = InputBox("Duur :")
        With ActiveCell
            .Value = c1
             .Offset(1) = c0
            trm = Split(c0, "+")
            .Offset(, 1) = DateDiff("w", c1, Date, 2) & " wkn " & DateDiff("d", c1, Date, 2) Mod 7 & " dgn"
            .Offset(2) = "nu " & trm(0) + DateDiff("w", c1, Date, 2) & "+" & trm(1)
        End With
    End With
    Unload Me
End Sub

 

[Nicu]

Cobbe dit ziet er al prachtig uit, vannacht ga ik van Rudi nog proberen. Ik ben alleen 1 dingen vergeten erbij te melden, deze lijst wordt dagelijks aangevuld/gewijzigd. Dan moet dus elke dag de dagen mee veranderen, is dit ook mogelijk?

 

[Nicu]

Warm bakkertje ik zet jouw script ipv die van Cobbe, maar dan gebeurt er niets en is mijn kalender ook verdwenen, als ik dan weer undo blijft mijn kalender nog steeds weg. Ik was heel benieuwd naar jouw versie, maar het lukt me niet.
Maar is het bij jouw versie wel mogelijk om dagelijks de dagen mee te veranderen?

 

[Warme bakkertje]

Zie bijlage.
Dat met die dagen moet je wel even verder uitleggen want ik ben niet mee.

 

[Nicu]

Werkt top!
Wat ik bedoel met die dagen is het volgende:
Als er vandaag een kind geboren wordt met 24+2 zwangerschapsduur, dan zegt het script prima dat het kind nu 0 wkn en 0 dgn. Maar als ik morgen dan deze lijst weer open moet de berekening ook weer zijn werk doen, want nu is het kind 0 wkn en 1 dgn en moet de cel onder 24+2, 24+3 zijn. Dit moet eigenlijk wel automatisch gebeuren.

 

[Warme bakkertje]

Ook nachtdienst?

Zegt mijn nickname niet genoeg ?

OK dus de eerst ingebrachte duur is statisch (24+2) en elke dag komt er bij de berekening 1 dag bij.
Dus stel vandaag wordt een kind geboren met zwangerschapsduur 31+6. Wordt het bij de herberekening de volgende dag dan 31+7 of 32+0 ?(aangezien je eerder schreef dat eerst ingebrachte duur maximaal +6 is).

 

[Nicu]

Ik word altijd hongerig als ik je nickname zie vooral in de nachtdienst.....

JE conclusie is juist. 31+7 wordt niet gebruikt, het wordt dan 32+0 Het viel me op dat het niet mogelijk is om dan 32 neer te zetten. Er zijn kinderen die dus op 32+0 geboren worden en soms wordt dan nog weleens 32 wkn neergezet. Mocht beide opties niet mogelijk zijn, dan zou ik dit ook kunnen uitleggen in het scherm wat komt bij "duur".

 

[Warme bakkertje]

Nog een laatste vraag voor ik eraan begin. Bij de invoering v/d gegevens moet er dan ook rekening gehouden worden met de dagen of niet ?
Wat ik bedoel is stel je voert een geboortedatum in en je krijgt als berekening 7 wkn en 3 dgn en bij duur vul je 27+2 in. Krijg je in de nu-cel dan 34+2 of 34+5 (dus de 3 dagen v/d berekening er al bij tellen)

 

[Nicu]

Ik zou zeggen 34+5
De geboortedatum en de zwangerschapsduur zijn een vast gegeven, maar in de praktijk zeggen we dan altijd als een kind van 27+2, 3 dagen oud is, dat hij nu 27+5 is. Elke dag dat hij leeft wordt er dus 1 dag bij opgeteld.

 

[Warme bakkertje]

Dit zou het moeten zijn. Weken en dagen worden bijgeteld. Als dagen > 6 wordt weken en dagen automatisch herleid naar nieuwe week en resterende dagen.
Dagelijks worden bij het openen v/h bestand alle ingevulde data automatisch aangepast naar dagen +1.

 

[Nicu]

Werkt helemaal geweldig, enorm bedankt!!!!
Ik neem aan dat als ik dit bij meerdere sheet wil, ik alleen maar de sheet hoef te kopieren en bij THISWORKBOOK het volgende moet veranderen: With Sheets("Unit 1, Unit2, Unit3")

 

[Warme bakkertje]

Probeer het eens met deze bijlage.

 

[Nicu]

Werkt helemaal goed, thanks nogmaals ;-)
Die aparte sheet met Data had ik zelf eerder moeten doen, dit werkt veel overzichtelijker.
Ik ga er weer lekker verder mee sleutelen.

 

[Nicu]

Ben helaas nog een probleem tegengekomen. In cel XFD 1 stond een datum, deze heb ik weggehaald omdat ik anders een probleem met printen had. Tevens heb ik een beveiliging op de sheets gezet. Maar als ik nu het bestand weer open krijg ik een "Fout 1004 tijdens uitvoering" te zien. Als ik nu op foutoplossing klik laat VBA de in het roodgekleurde zien opvallen. Hoe kan ik dit oplossen en wat betekent deze zin precies?

Private Sub Workbook_Open()
For j = 1 To 3
    With Sheets("Unit " & j)
        If CDbl(.Cells(1, .Columns.Count)) < CDbl(Date) Then
            For i = 3 To 45 Step 6
                If .Cells(i, 2) <> vbNullString Then
                    weeks = DateDiff("w", .Cells(i, 2), Date, 2): days = DateDiff("d", .Cells(i, 2), Date, 2) Mod 7
                    .Cells(i, 2).Offset(, 1) = weeks & " wkn " & days & " dgn"
                    trm = Split(.Cells(i, 2).Offset(1), "+")
                    nuweeks = trm(0) + weeks: nudays = trm(1) + days
                    If nudays > 6 Then
                        nuweeks = nuweeks + IIf(nudays Mod 6 <> 0, 1, 2)
                        nudays = nudays Mod 6
                    End If
                    .Cells(i, 2).Offset(2) = "nu " & nuweeks & "+" & nudays
                End If
            Next
        End If
[COLOR="#FF0000"]        .Cells(1, .Columns.Count) = Date[/COLOR]
    End With
Next
End Sub

 

[Warme bakkertje]

Deze is nodig om te kijken of de herberekening al gebeurt is die dag (in geval het bestand meermaals per dag geopend en gesloten wordt). Werkt samen met

If CDbl(.Cells(1, .Columns.Count)) < CDbl(Date) Then

Wat betreft beveiliging zal je dus de cel XFD1 moeten ontgrendelen zodat er ook naar geschreven kan worden.
Wat betreft printen zal je je printbereik via code moeten instellen zodat het enkel door jou ingestelde bereik wordt geprint.

 

[Nicu]

Dat verklaard een hele hoop. Is het niet mogelijk de verwijzing naar deze datum op een andere cel neer te zetten, die ik daarna dan weer verberg?

 

[Warme bakkertje]

Die mag jij van mij zetten waar jij wil, zolang ze beiden maar overeenkomen voor de controle.