J
JonWayn
I have a really simple solution. When Word opens, a form is loaded that has
the following controls:
3 combo boxes: cboYear, cboMonth, cboDate
4 command buttons: cmdPrev, cmdNext, cmdUpdate, cmdClose
When the form loads, the combo boxes are initialized to constitute the date
of the next monday, the current day included.
Once loaded, the user can set any date he wishes using any combination of
the combo boxes.
The cmdUpdate button updates 5 bookmarks on the document.
cmdClose obviously closes the form
cmdPrev and cmdNext change the value of the combo boxes to display the date
of the previous, or next week. These are the controls that are triggering the
error. After about 6 or so clicks, I get the Out of Stack Space error. Its a
pretty small module with no recursion whatsoever. The whole module codes are
pasted below. Any ideas. Thanks.
================== C O D E * B E L O W ===================
Option Explicit
Dim Changed As Boolean
Dim Cnt%
Private Sub cboDate_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsDate(cboMonth & "/" & cboDate & "/" & cboYear) Then
MsgBox "Invalid entry. Only monday dates are allowed. Select or
enter a date from the listed values"
Cancel = True
End If
End Sub
Private Sub cboDate_Change()
Changed = Cnt = 1
End Sub
Private Sub cboMonth_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsDate(cboMonth & "/1/" & cboYear) Or IsNumeric(cboMonth) Then
Cancel = -1
MsgBox "Invalid entry. Select or enter one of the listed month values"
End If
End Sub
Private Sub cboMonth_Change()
Dim x%, Span%, d%
Dim dte As Date, dte2 As Date
Changed = Cnt = 1
cboDate.Clear
dte = cboMonth & "/1/" & cboYear
dte2 = DateAdd("m", 1, dte) - 1
Span = DateDiff("d", dte, dte2) + 1
For x = 1 To Span
If Format(dte, "ddd") = "Mon" Then
d = Format(dte, "d")
cboDate.AddItem d
dte2 = cboMonth & "/" & d & "/" & cboYear
If dte2 >= Date And cboDate = "" Then cboDate = d
End If
dte = dte + 1
Next
ValidateDates
End Sub
Private Sub cboYear_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsDate(cboMonth & "/1/" & cboYear) Then
Cancel = -1
MsgBox "Invalid Year entry. Select or enter one of the listed values"
End If
End Sub
Private Sub cboYear_Change()
Dim x%, m%
Dim dte As Date
Changed = Cnt = 1
cboMonth.Clear
If CInt(cboYear) = Year(Date) Then
m = Format(Date, "m")
Else
m = 1
End If
For x = m To 12
cboMonth.AddItem Format(x & "/1/" & cboYear, "mmmm")
Next
If cboMonth <> "" Then ValidateDates
End Sub
Sub ValidateDates()
Dim dte As Date
Dim x%
dte = cboMonth & "/" & cboDate & "/" & cboYear
If Not IsDate(dte) Or Format(dte, "ddd") <> "Mon" Then
cboMonth_Change
If cboMonth & cboYear = Format(Date, "mmmmyyyy") Then
For x = 0 To cboDate.ListCount - 1
dte = cboMonth & "/" & cboDate.List(x) & "/" & cboYear
If dte >= Date Then
cboDate = cboDate.List(x)
Exit For
End If
Next
Else
cboDate = cboDate.List(0)
End If
End If
End Sub
Private Sub cmdNext_Click()
Dim dte As Date
dte = cboMonth & "/" & cboDate & "/" & cboYear
dte = DateAdd("ww", 1, dte)
cboYear = Year(dte)
cboMonth = Format(dte, "mmmm")
cboDate = Day(dte)
End Sub
Private Sub cmdPrev_Click()
Dim dte As Date
dte = cboMonth & "/" & cboDate & "/" & cboYear
dte = DateAdd("ww", -1, dte)
cboYear = Year(dte)
cboMonth = Format(dte, "mmmm")
cboDate = Day(dte)
End Sub
Private Sub cmdUpdate_Click()
Dim dte As Date
Dim bmk As Bookmark, rng As Range, Doc As Document
Dim x%
Set Doc = ThisDocument
dte = cboMonth & "/" & cboDate & "/" & cboYear
Set rng = Doc.Bookmarks("MonDate").Range
rng.Text = Format(dte, "mm/dd/yyyy")
Doc.Bookmarks.Add "MonDate", rng
dte = dte + 1
Set rng = Doc.Bookmarks("TueDate").Range
rng.Text = Format(dte, "mm/dd/yyyy")
Doc.Bookmarks.Add "TueDate", rng
dte = dte + 1
Set rng = Doc.Bookmarks("WedDate").Range
rng.Text = Format(dte, "mm/dd/yyyy")
Doc.Bookmarks.Add "WedDate", rng
dte = dte + 1
Set rng = Doc.Bookmarks("ThuDate").Range
rng.Text = Format(dte, "mm/dd/yyyy")
Doc.Bookmarks.Add "ThuDate", rng
dte = dte + 1
Set rng = Doc.Bookmarks("FriDate").Range
rng.Text = Format(dte, "mm/dd/yyyy")
Doc.Bookmarks.Add "FriDate", rng
Changed = False
Set bmk = Nothing
Set rng = Nothing
Set Doc = Nothing
End Sub
Private Sub UserForm_Initialize()
Dim Yr%, x%
Yr = Year(Date)
cboYear = Yr
cboMonth = Format(Date, "mmmm")
For x = 1 To 2
cboYear.AddItem Yr
Yr = Yr + 1
Next x
Cnt = 1
End Sub
Private Sub UserForm_Terminate()
Dim Response%
If Changed Then
Response = MsgBox("Do you want to update the document with the
changes you made?", vbQuestion + vbYesNo, "Commit Changes")
If Response = vbYes Then cmdUpdate_Click
End If
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
the following controls:
3 combo boxes: cboYear, cboMonth, cboDate
4 command buttons: cmdPrev, cmdNext, cmdUpdate, cmdClose
When the form loads, the combo boxes are initialized to constitute the date
of the next monday, the current day included.
Once loaded, the user can set any date he wishes using any combination of
the combo boxes.
The cmdUpdate button updates 5 bookmarks on the document.
cmdClose obviously closes the form
cmdPrev and cmdNext change the value of the combo boxes to display the date
of the previous, or next week. These are the controls that are triggering the
error. After about 6 or so clicks, I get the Out of Stack Space error. Its a
pretty small module with no recursion whatsoever. The whole module codes are
pasted below. Any ideas. Thanks.
================== C O D E * B E L O W ===================
Option Explicit
Dim Changed As Boolean
Dim Cnt%
Private Sub cboDate_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsDate(cboMonth & "/" & cboDate & "/" & cboYear) Then
MsgBox "Invalid entry. Only monday dates are allowed. Select or
enter a date from the listed values"
Cancel = True
End If
End Sub
Private Sub cboDate_Change()
Changed = Cnt = 1
End Sub
Private Sub cboMonth_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsDate(cboMonth & "/1/" & cboYear) Or IsNumeric(cboMonth) Then
Cancel = -1
MsgBox "Invalid entry. Select or enter one of the listed month values"
End If
End Sub
Private Sub cboMonth_Change()
Dim x%, Span%, d%
Dim dte As Date, dte2 As Date
Changed = Cnt = 1
cboDate.Clear
dte = cboMonth & "/1/" & cboYear
dte2 = DateAdd("m", 1, dte) - 1
Span = DateDiff("d", dte, dte2) + 1
For x = 1 To Span
If Format(dte, "ddd") = "Mon" Then
d = Format(dte, "d")
cboDate.AddItem d
dte2 = cboMonth & "/" & d & "/" & cboYear
If dte2 >= Date And cboDate = "" Then cboDate = d
End If
dte = dte + 1
Next
ValidateDates
End Sub
Private Sub cboYear_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsDate(cboMonth & "/1/" & cboYear) Then
Cancel = -1
MsgBox "Invalid Year entry. Select or enter one of the listed values"
End If
End Sub
Private Sub cboYear_Change()
Dim x%, m%
Dim dte As Date
Changed = Cnt = 1
cboMonth.Clear
If CInt(cboYear) = Year(Date) Then
m = Format(Date, "m")
Else
m = 1
End If
For x = m To 12
cboMonth.AddItem Format(x & "/1/" & cboYear, "mmmm")
Next
If cboMonth <> "" Then ValidateDates
End Sub
Sub ValidateDates()
Dim dte As Date
Dim x%
dte = cboMonth & "/" & cboDate & "/" & cboYear
If Not IsDate(dte) Or Format(dte, "ddd") <> "Mon" Then
cboMonth_Change
If cboMonth & cboYear = Format(Date, "mmmmyyyy") Then
For x = 0 To cboDate.ListCount - 1
dte = cboMonth & "/" & cboDate.List(x) & "/" & cboYear
If dte >= Date Then
cboDate = cboDate.List(x)
Exit For
End If
Next
Else
cboDate = cboDate.List(0)
End If
End If
End Sub
Private Sub cmdNext_Click()
Dim dte As Date
dte = cboMonth & "/" & cboDate & "/" & cboYear
dte = DateAdd("ww", 1, dte)
cboYear = Year(dte)
cboMonth = Format(dte, "mmmm")
cboDate = Day(dte)
End Sub
Private Sub cmdPrev_Click()
Dim dte As Date
dte = cboMonth & "/" & cboDate & "/" & cboYear
dte = DateAdd("ww", -1, dte)
cboYear = Year(dte)
cboMonth = Format(dte, "mmmm")
cboDate = Day(dte)
End Sub
Private Sub cmdUpdate_Click()
Dim dte As Date
Dim bmk As Bookmark, rng As Range, Doc As Document
Dim x%
Set Doc = ThisDocument
dte = cboMonth & "/" & cboDate & "/" & cboYear
Set rng = Doc.Bookmarks("MonDate").Range
rng.Text = Format(dte, "mm/dd/yyyy")
Doc.Bookmarks.Add "MonDate", rng
dte = dte + 1
Set rng = Doc.Bookmarks("TueDate").Range
rng.Text = Format(dte, "mm/dd/yyyy")
Doc.Bookmarks.Add "TueDate", rng
dte = dte + 1
Set rng = Doc.Bookmarks("WedDate").Range
rng.Text = Format(dte, "mm/dd/yyyy")
Doc.Bookmarks.Add "WedDate", rng
dte = dte + 1
Set rng = Doc.Bookmarks("ThuDate").Range
rng.Text = Format(dte, "mm/dd/yyyy")
Doc.Bookmarks.Add "ThuDate", rng
dte = dte + 1
Set rng = Doc.Bookmarks("FriDate").Range
rng.Text = Format(dte, "mm/dd/yyyy")
Doc.Bookmarks.Add "FriDate", rng
Changed = False
Set bmk = Nothing
Set rng = Nothing
Set Doc = Nothing
End Sub
Private Sub UserForm_Initialize()
Dim Yr%, x%
Yr = Year(Date)
cboYear = Yr
cboMonth = Format(Date, "mmmm")
For x = 1 To 2
cboYear.AddItem Yr
Yr = Yr + 1
Next x
Cnt = 1
End Sub
Private Sub UserForm_Terminate()
Dim Response%
If Changed Then
Response = MsgBox("Do you want to update the document with the
changes you made?", vbQuestion + vbYesNo, "Commit Changes")
If Response = vbYes Then cmdUpdate_Click
End If
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub