perhol
01-23-2008, 02:16 PM
Have been searching a way to close a userform calendar control by pressing ESC.
I found something in this thread: http://vbaexpress.com/forum/showthread.php?t=16667&highlight=form+close+on+ESC
Only i cant figure out where to put the code :banghead:
The userform i am using comes from this: http://vbaexpress.com/kb/getarticle.php?kb_id=543
But is slightly modyfied by xld.
Here is the main part.
Option Explicit
Dim ThisDay As Date
Dim ThisYear, ThisMth As Date
Dim CreateCal As Boolean
Dim i As Integer
Private Sub UserForm_Initialize()
Application.EnableEvents = False
'Starter formularen p? dagsdato
ThisDay = Date
ThisMth = Format(ThisDay, "mm")
ThisYear = Format(ThisDay, "yyyy")
For i = 1 To 12
CB_Mth.AddItem Format(DateSerial(Year(Date), Month(Date) + i, 0), "mmmm")
Next
CB_Mth.ListIndex = Format(Date, "mm") - Format(Date, "mm")
For i = -20 To 50
If i = 1 Then CB_Yr.AddItem Format((ThisDay), "yyyy") Else CB_Yr.AddItem _
Format((DateAdd("yyyy", (i - 1), ThisDay)), "yyyy")
Next
CB_Yr.ListIndex = 21
'Opbygger kalenderen med dagsdato
CalendarFrm.Width = CalendarFrm.Width
CreateCal = True
Call Build_Calendar
Application.EnableEvents = True
End Sub
Private Sub CB_Mth_Change()
'Genopbygger kalenderen n?r m?neden ?ndres af brugeren
Build_Calendar
End Sub
Private Sub CB_Yr_Change()
'Genopbygger kalenderen n?r ?ret ?ndres af brugeren
Build_Calendar
End Sub
Private Sub Build_Calendar()
'Rutinen der rent faktisk opbygger kalenderen hver gang
If CreateCal = True Then
CalendarFrm.Caption = " " & CB_Mth.Value & " " & CB_Yr.Value
'S?tter focus p? knappen for dagsdato
CommandButton1.SetFocus
For i = 1 To 42
If i < Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value)) Then
Controls("D" & (i)).Caption = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value), 2)), _
((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "d")
Controls("D" & (i)).ControlTipText = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value), 2)), _
((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "d-mmm-yyyy")
' Controls("D" & (i)).ControlTipText = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value), 2)), _
' ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "d/m/yy")
ElseIf i >= Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value)) Then
Controls("D" & (i)).Caption = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) _
& "/1/" & (CB_Yr.Value), 2)), ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "d")
Controls("D" & (i)).ControlTipText = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value), 2)), _
((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "d-mmm-yyyy")
' Controls("D" & (i)).ControlTipText = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value), 2)), _
' ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "d/m/yy")
End If
If Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value), 2)), _
((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "mmmm") = ((CB_Mth.Value)) Then
If Controls("D" & (i)).BackColor <> &H80000016 Then Controls("D" & (i)).BackColor = &H80000018 '&H80000010
Controls("D" & (i)).Font.Bold = True
If Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value), 2)), _
((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "m/d/yy") = Format(ThisDay, "m/d/yy") Then Controls("D" & (i)).SetFocus
Else
If Controls("D" & (i)).BackColor <> &H80000016 Then Controls("D" & (i)).BackColor = &H8000000F
Controls("D" & (i)).Font.Bold = False
End If
Next
End If
End Sub
followed by 42 of this.
Private Sub D1_Click()
ActiveCell.Value = D1.ControlTipText
Unload Me
End Sub
Can anyone explain where to insert the code Simon Lloyd suggest in http://www.vbaexpress.com/forum/showthread.php?t=16667 ?
I found something in this thread: http://vbaexpress.com/forum/showthread.php?t=16667&highlight=form+close+on+ESC
Only i cant figure out where to put the code :banghead:
The userform i am using comes from this: http://vbaexpress.com/kb/getarticle.php?kb_id=543
But is slightly modyfied by xld.
Here is the main part.
Option Explicit
Dim ThisDay As Date
Dim ThisYear, ThisMth As Date
Dim CreateCal As Boolean
Dim i As Integer
Private Sub UserForm_Initialize()
Application.EnableEvents = False
'Starter formularen p? dagsdato
ThisDay = Date
ThisMth = Format(ThisDay, "mm")
ThisYear = Format(ThisDay, "yyyy")
For i = 1 To 12
CB_Mth.AddItem Format(DateSerial(Year(Date), Month(Date) + i, 0), "mmmm")
Next
CB_Mth.ListIndex = Format(Date, "mm") - Format(Date, "mm")
For i = -20 To 50
If i = 1 Then CB_Yr.AddItem Format((ThisDay), "yyyy") Else CB_Yr.AddItem _
Format((DateAdd("yyyy", (i - 1), ThisDay)), "yyyy")
Next
CB_Yr.ListIndex = 21
'Opbygger kalenderen med dagsdato
CalendarFrm.Width = CalendarFrm.Width
CreateCal = True
Call Build_Calendar
Application.EnableEvents = True
End Sub
Private Sub CB_Mth_Change()
'Genopbygger kalenderen n?r m?neden ?ndres af brugeren
Build_Calendar
End Sub
Private Sub CB_Yr_Change()
'Genopbygger kalenderen n?r ?ret ?ndres af brugeren
Build_Calendar
End Sub
Private Sub Build_Calendar()
'Rutinen der rent faktisk opbygger kalenderen hver gang
If CreateCal = True Then
CalendarFrm.Caption = " " & CB_Mth.Value & " " & CB_Yr.Value
'S?tter focus p? knappen for dagsdato
CommandButton1.SetFocus
For i = 1 To 42
If i < Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value)) Then
Controls("D" & (i)).Caption = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value), 2)), _
((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "d")
Controls("D" & (i)).ControlTipText = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value), 2)), _
((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "d-mmm-yyyy")
' Controls("D" & (i)).ControlTipText = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value), 2)), _
' ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "d/m/yy")
ElseIf i >= Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value)) Then
Controls("D" & (i)).Caption = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) _
& "/1/" & (CB_Yr.Value), 2)), ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "d")
Controls("D" & (i)).ControlTipText = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value), 2)), _
((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "d-mmm-yyyy")
' Controls("D" & (i)).ControlTipText = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value), 2)), _
' ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "d/m/yy")
End If
If Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value), 2)), _
((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "mmmm") = ((CB_Mth.Value)) Then
If Controls("D" & (i)).BackColor <> &H80000016 Then Controls("D" & (i)).BackColor = &H80000018 '&H80000010
Controls("D" & (i)).Font.Bold = True
If Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value), 2)), _
((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "m/d/yy") = Format(ThisDay, "m/d/yy") Then Controls("D" & (i)).SetFocus
Else
If Controls("D" & (i)).BackColor <> &H80000016 Then Controls("D" & (i)).BackColor = &H8000000F
Controls("D" & (i)).Font.Bold = False
End If
Next
End If
End Sub
followed by 42 of this.
Private Sub D1_Click()
ActiveCell.Value = D1.ControlTipText
Unload Me
End Sub
Can anyone explain where to insert the code Simon Lloyd suggest in http://www.vbaexpress.com/forum/showthread.php?t=16667 ?