DateTimePicker default ''today''

Status
Niet open voor verdere reacties.
B

Bateendje

Nieuwe gebruiker
Lid geworden
11 nov 2011
Berichten
4
Hoe krijg ik het voor elkaar om de datetimepicker default de atum van vandaag te tonen.
Het gaat om Visual basic in Word 2007.

Hieronder een onderdeel van mijn experiment, invulformulier (nawform) tbv een sjabloon:

Code: 
Private Sub DTPicker1_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)
DateTimePicker1.Value.Day  <- deze wil maar niet!! :evil:

End Sub
Code: 
Private Sub Invoegknop_Click()
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

ActiveDocument.Bookmarks("BLVoetDatum").Select
'Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "DATE  ", PreserveFormatting:=True
DTPicker1.Enabled = False
Selection.TypeText CStr(DTPicker1.Value)

Unload NAWform
End Sub

Private Sub Annuleerknop_Click()
Unload NAWform
End Sub

'dtpDateSelection.Value = Now

Ik ben iedereen zeer dankbaar voor een oplossing, zit al dagen te proberen.
 
Laatst bewerkt door een moderator:
Visual basic in word (VBA) heeft standaard geen DT-picker. Visual basic in het algemeen heeft wel een DT-picker, maar die staat standaard ingesteld op de datum van vandaag. Kun je misschien verder aangeven wat en in welke omgeving je dit probeerd te doen?
 
Beste "Bateendje",

Ik heb uw vraag verplaatst van "Visual Basic" naar "Visual Basic for Applications".

Met vriendelijke groet,
Stefan (Tha Devil)
Moderator Helpmij.nl
 
DatePicker

In het verleden heb ik best veel problemen gehad met het gebruik van de datepicker die standaard wordt meegeleverd in VBA. Het probleem met verwijzingen en verschillende versies van Excel etc.

Daarvoor heb ik zelf een niet activeX userform gebouwd, nou ja de code bouwt het formulier zelf, er zit wel en class aan waar je wat aanpassingen in zal moeten maken om het zo toe te passen dat het ook in jouw code functioneert.

De gekozen waarde wordt namelijk meegeven aan de op dat moment actieve cel.

Kijk er eens naar en ik hoop dat een ieder hier er iets aan heeft!
 

Bijlagen

  • MyDatePickerNoneActiveX.xls
    93,5 KB · Weergaven: 49
Er zit nog een easteregg in...

Ik zie dat er een paar extra functies in staan, voor het berekenen van de feestdagen. De functiebenaming is wel in het Engels, maar ik denk dat er een hoop hier blij mee zullen zijn!

Code: 
' Author    : Interface
' Date      : 12-1-2012
' Purpose   : Helpmij
'---------------------------------------------------------------------------------------

'/////////////////////////////////////////////////////////////////////////////////
'                           Holiday function
'/////////////////////////////////////////////////////////////////////////////////

Option Explicit

Function funIsSpecialDay(ByVal oDate As Date) As Boolean

funIsSpecialDay = False

Select Case oDate
    Case Is = funEaster1(Year(oDate))                   '1e paasdag
        funIsSpecialDay = True
    Case Is = funEaster2(Year(oDate))                   '2e paasdag
        funIsSpecialDay = True
    Case Is = funPentecost1(Year(oDate))                '1e pinksteren
        funIsSpecialDay = True
    Case Is = funPentecost2(Year(oDate))                '2e pinksteren
        funIsSpecialDay = True
    Case Is = funAscension(Year(oDate))                 'hemelvaart
        funIsSpecialDay = True
    Case Is = funGoodFriday(Year(oDate))                'Goede vrijdag
        funIsSpecialDay = True
    Case Is = CDate("31-12-" & Year(oDate))             'Oud en nieuw
        funIsSpecialDay = True
    Case Is = CDate("1-1-" & Year(oDate))               'nieuwjaarsdag
        funIsSpecialDay = True
    Case Is = CDate("30-4-" & Year(oDate))              'Koninginnedag
        funIsSpecialDay = True
End Select

End Function

Function funWhatSpecialDay(ByVal oDate As Date) As String

If funIsSpecialDay(oDate) = True Then
    Select Case oDate
        Case Is = funEaster1(Year(oDate))               '1e paasdag
            funWhatSpecialDay = "1e Paasdag"
        Case Is = funEaster2(Year(oDate))               '2e paasdag
            funWhatSpecialDay = "2e Paasdag"
        Case Is = funPentecost1(Year(oDate))            '1e pinksteren
            funWhatSpecialDay = "1e Pinksterdag"
        Case Is = funPentecost2(Year(oDate))            '2e pinksteren
            funWhatSpecialDay = "2e Pinksterdag"
        Case Is = funAscension(Year(oDate))             'hemelvaart
            funWhatSpecialDay = "Hemelvaartsdag"
        Case Is = funGoodFriday(Year(oDate))            'Goede vrijdag
            funWhatSpecialDay = "Goede vrijdag"
        Case Is = CDate("31-12-" & Year(oDate))         'oudejaarsdag
            funWhatSpecialDay = "Oudejaarsdag"
        Case Is = CDate("1-1-" & Year(oDate))           'nieuwjaarsdag
            funWhatSpecialDay = "Nieuwjaarsdag"
        Case Is = CDate("30-4-" & Year(oDate))          'Koninginnedag
            funWhatSpecialDay = "Koninginnedag"
    End Select
End If

End Function

Function funEaster1(ByVal Year As Integer) As Date      '1e paasdag

Dim intYear, intMonth, intDay As Integer
Dim g, i, j, c, h, l As Integer
Dim e As Date

g = Year Mod 19
c = Int(Year / 100)
h = (c - Int(c / 4) - Int((8 * c + 13) / 25) + 19 * g + 15) Mod 30
i = h - Int((h / 28)) * (1 - Int((h / 28)) * Int((29 / (h + 1))) * Int(((21 - g) / 11)))
j = (Year + Int(Year / 4) + i + 2 - c + Int(c / 4)) Mod 7
l = i - j

intMonth = 3 + Int((l + 40) / 44)
intDay = l + 28 - 31 * Int((intMonth / 4))
intYear = Year

e = DateSerial(intYear, intMonth, intDay)

While Weekday(e) > 1
    e = e + 1
Wend

funEaster1 = e

End Function

Function funEaster2(ByVal intYear As Integer) As Date                   'pasen(2e)

    funEaster2 = DateSerial(Year(funEaster1(intYear)), Month(funEaster1(intYear)), Day(funEaster1(intYear)) + 1)

End Function

Function funPentecost1(ByVal intYear As Integer) As Date                'pinksteren(1e)

    funPentecost1 = DateSerial(intYear, Month(funEaster1(intYear)), Day(funEaster1(intYear)) + 49)

End Function
Function funPentecost2(ByVal intYear As Integer) As Date                'pinksteren(2e)

    funPentecost2 = DateSerial(intYear, Month(funEaster1(intYear)), Day(funEaster1(intYear)) + 50)

End Function

Function funAscension(ByVal intYear As Integer) As Date                 'hemelvaartsdag

    funAscension = DateSerial(Year(funEaster1(intYear)), Month(funEaster1(intYear)), Day(funEaster1(intYear)) + 39)

End Function

Function funGoodFriday(ByVal intYear As Integer) As Date                'Goede vrijdag

    funGoodFriday = DateSerial(Year(funEaster1(intYear)), Month(funEaster1(intYear)), Day(funEaster1(intYear)) - 2)

End Function
Function funLenMonth(datDate As Date) As Integer

    funLenMonth = DateSerial(Year(datDate), Month(datDate) + 1, 1) - DateSerial(Year(datDate), Month(datDate), 1)

End Function

'////////////////////////////////////////////////////////////////////////////////////////
'                       Week and Date functions
'////////////////////////////////////////////////////////////////////////////////////////

Function funFirstDayValueOfMonth(ByVal datDate As Date) As Byte

    funFirstDayValueOfMonth = Weekday(DateSerial(Year(datDate), Month(datDate), 1), vbMonday)

End Function

Function funConvertWeekNrToBeginDate(ByVal intWeek As Integer, ByVal intYear As Integer) As Date

Dim i As Integer

For i = 1 To 6
    If Weekday(DateSerial(intYear, 1, 1 + i), 1) = 1 Then
        funConvertWeekNrToBeginDate = DateSerial(intYear, 1, 2 + (i + (intWeek - 1) * 7))
        Exit For
    End If
Next i

End Function

Function funWeekNr(ByVal datDate As Date) As Integer
    
    funWeekNr = DatePart("ww", datDate, vbMonday, vbFirstFourDays)

End Function
 
Mmm :chinrub:
Geloof dat het niet gaat lukken, ondanks de allerbeste bedoelingen ben ik (nog) geen expert in dit soort codes.
Ik hoop wel dat anderen er wat aan hebben, het ziet er namelijk heel handig uit zo´n overzichtelijk stuk codering.
Voorlopig ben ik verder aan het (onder)zoeken, lukt het niet dan maar een andere oplossing bedenken. :confused:

In ieder geval dank allen!!
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan