Private Sub EnableControls(Enabled As Boolean)
If Enabled = True Then
Me.optd.Enabled = True
Me.optdd.Enabled = True
Me.optm.Enabled = True
Me.optmm.Enabled = True
Me.optmmm.Enabled = True
Me.optmmmm.Enabled = True
Me.optyy.Enabled = True
Me.optyyyy.Enabled = True
Me.chkddd.Enabled = True
Me.chkdddd.Enabled = True
Me.lblDay.Enabled = True
Me.lblMonth.Enabled = True
Me.lblYear.Enabled = True
Else
Me.optd.Enabled = False
Me.optdd.Enabled = False
Me.optm.Enabled = False
Me.optmm.Enabled = False
Me.optmmm.Enabled = False
Me.optmmmm.Enabled = False
Me.optyy.Enabled = False
Me.optyyyy.Enabled = False
Me.chkddd.Enabled = False
Me.chkdddd.Enabled = False
Me.lblDay.Enabled = False
Me.lblMonth.Enabled = False
Me.lblYear.Enabled = False
End If
End Sub
Private Function DateFormat() As String
Dim strDayName As String
Dim strDayNumber As String
Dim strMonth As String
Dim strYear As String
Dim strSeparator As String
If Me.chkddd.Value = True Then
strDayName = "ddd, "
ElseIf Me.chkdddd = True Then
strDayName = "dddd, "
Else
strDayName = ""
End If
If Me.optd.Value = True Then
strDayNumber = "d"
Else
strDayNumber = "dd"
End If
If Me.optm.Value = True Then
strMonth = "m"
strSeparator = "/"
ElseIf Me.optmm.Value = True Then
strMonth = "mm"
strSeparator = "/"
ElseIf Me.optmmm.Value = True Then
strMonth = "mmm"
strSeparator = " "
Else
strMonth = "mmmm"
strSeparator = " "
End If
If Me.optyy = True Then
strYear = "yy"
Else
strYear = "yyyy"
End If
DateFormat = strDayName & strDayNumber & strSeparator _
& strMonth & strSeparator & strYear
End Function
Private Sub Calendar1_Click()
If Me.chkCustom.Value = True Then
Me.lblSample.Caption = Format(Me.Calendar1.Value, Me.txtCustom.Value)
Else
Me.lblSample.Caption = Format(Me.Calendar1.Value, DateFormat)
End If
Me.cmdOK.Enabled = True
End Sub
Private Sub Calendar1_NewMonth()
Me.cmdOK.Enabled = False
End Sub
Private Sub Calendar1_NewYear()
Me.cmdOK.Enabled = False
End Sub
Private Sub chkCustom_Change()
If Me.chkCustom.Value = True Then
Me.txtCustom.Enabled = True
Me.lblSample.Caption = Format(Me.Calendar1.Value, Me.txtCustom.Value)
EnableControls (False)
Else
Me.txtCustom.Enabled = False
Me.lblSample.Caption = Format(Me.Calendar1.Value, DateFormat)
EnableControls (True)
End If
End Sub
Private Sub chkddd_AfterUpdate()
If Me.chkddd.Value = True Then
Me.chkdddd.Value = False
End If
Me.lblSample.Caption = Format(Me.Calendar1.Value, DateFormat)
End Sub
Private Sub chkdddd_AfterUpdate()
If Me.chkdddd.Value = True Then
Me.chkddd.Value = False
End If
Me.lblSample.Caption = Format(Me.Calendar1.Value, DateFormat)
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdDefault_Click()
Dim ctl As Control
For Each ctl In Me.Controls
If TypeName(ctl) = "CheckBox" Or _
TypeName(ctl) = "OptionButton" Or _
TypeName(ctl) = "TextBox" Then
SaveSetting AppName:="FontStuff", _
Section:="WordPopupCalendar", _
Key:=ctl.Name, Setting:=ctl.Value
End If
Next ctl
End Sub
Private Sub cmdHelp_Click()
frmHelp.Show
End Sub
Private Sub cmdOK_Click()
If Me.chkCustom.Value = True Then
Selection.Text = Format(Me.Calendar1.Value, Me.txtCustom.Value)
Else
Selection.Text = Format(Me.Calendar1.Value, DateFormat)
End If
Selection.MoveRight Unit:=wdCharacter, Count:=1
Unload Me
End Sub
Private Sub optd_AfterUpdate()
Me.lblSample.Caption = Format(Me.Calendar1.Value, DateFormat)
End Sub
Private Sub optdd_AfterUpdate()
Me.lblSample.Caption = Format(Me.Calendar1.Value, DateFormat)
End Sub
Private Sub optm_AfterUpdate()
Me.lblSample.Caption = Format(Me.Calendar1.Value, DateFormat)
End Sub
Private Sub optmm_AfterUpdate()
Me.lblSample.Caption = Format(Me.Calendar1.Value, DateFormat)
End Sub
Private Sub optmmm_AfterUpdate()
Me.lblSample.Caption = Format(Me.Calendar1.Value, DateFormat)
End Sub
Private Sub optmmmm_AfterUpdate()
Me.lblSample.Caption = Format(Me.Calendar1.Value, DateFormat)
End Sub
Private Sub optyy_AfterUpdate()
Me.lblSample.Caption = Format(Me.Calendar1.Value, DateFormat)
End Sub
Private Sub optyyyy_AfterUpdate()
Me.lblSample.Caption = Format(Me.Calendar1.Value, DateFormat)
End Sub
Private Sub txtCustom_Change()
If Me.txtCustom.Value = "" Then
Me.chkCustom.Value = False
Me.lblSample.Caption = Format(Me.Calendar1.Value, DateFormat)
Else
Me.chkCustom = True
Me.txtCustom.SetFocus
Me.lblSample.Caption = Format(Me.Calendar1.Value, Me.txtCustom.Value)
End If
End Sub
Private Sub UserForm_Initialize()
Dim ctl As Control
If IsDate(Selection.Text) Then
Me.Calendar1.Value = DateValue(Selection.Text)
Else
Me.Calendar1.Value = Date
End If
Me.cmdOK.Enabled = True
If GetSetting("Fontstuff", "WordPopupCalendar", _
"chkddd") = "" Then
Me.optd.Value = True
Me.optm.Value = True
Me.optyy.Value = True
Me.chkCustom.Value = False
Else
For Each ctl In Me.Controls
If TypeName(ctl) = "CheckBox" Or _
TypeName(ctl) = "OptionButton" Or _
TypeName(ctl) = "TextBox" Then
ctl.Value = GetSetting(AppName:="FontStuff", _
Section:="WordPopupCalendar", _
Key:=ctl.Name)
End If
Next ctl
Me.chkCustom.Value = GetSetting("FontStuff", _
"WordPopupCalendar", "chkCustom")
End If
Me.lblSample.Caption = Format(Me.Calendar1.Value, DateFormat)
End Sub