M
Mike Rogers
I have a calendar pop up using Ron DeBruin’s code. I use this in many of my
spreadsheets and most have always worked as intended. I have two separate
worksheets that now the calendar is changing size each time they are opened.
The mystery is that on one the calendar gets larger, to the point that it
eventually fills the entire viewable screen. The other one gets smaller to
the point that you can’t read the dates on the calendar. Both scroll
properly. I have compared all the calendar properties for both and they are
the same. The code is the same, with the exception of the ranges used and
one does have an added code for placing check marks in a specified range, but
the code for the calendar is the same in both.
Here is the code that is in the worksheet that makes the calendar smaller:
Private Sub Calendar1_Click()
ActiveCell.Value = CDbl(Calendar1.Value)
ActiveCell.NumberFormat = "ddd mm/dd"
ActiveCell.Select
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("A5:A1520"), Target) Is Nothing Then
Calendar1.Left = Target.Left + Target.Width - Calendar1.Width
Calendar1.Top = Target.Top + Target.Height
Calendar1.Visible = True
' select Today's date in the Calendar
Calendar1.Value = Date
ElseIf Calendar1.Visible Then Calendar1.Visible = False
End If
End Sub
On several other worksheets this code works fine and has been for a couple
of years.
Here is the code from the worksheet that makes the calendar bigger:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("D4500,J4:J500,M4:M500"), Target)
Is Nothing Then
Calendar1.Left = Target.Left + Target.Width - Calendar1.Width
Calendar1.Top = Target.Top + Target.Height
Calendar1.Visible = True
' select Today's date in the Calendar
Calendar1.Value = Date
ElseIf Calendar1.Visible Then Calendar1.Visible = False
End If
Application.EnableEvents = False
On Error GoTo sub_exit
If Not Intersect(Target, Range("Checks")) Is Nothing Then
With Target
If .Value = "P" Then
.Value = ""
Else
.Value = "P"
.Font.Name = "Wingdings 2"
End If
End With
End If
sub_exit:
Application.EnableEvents = True
End Sub
Private Sub Calendar1_Click()
ActiveCell.Value = CDbl(Calendar1.Value)
ActiveCell.NumberFormat = "ddd mmm dd"
ActiveCell.Select
End Sub
This code is particular to this one worksheet because I needed the
checkmarks and combined the two macros (cobbled as it may be it does the job).
Any help/direction would be appreciated
Mike Rogers
spreadsheets and most have always worked as intended. I have two separate
worksheets that now the calendar is changing size each time they are opened.
The mystery is that on one the calendar gets larger, to the point that it
eventually fills the entire viewable screen. The other one gets smaller to
the point that you can’t read the dates on the calendar. Both scroll
properly. I have compared all the calendar properties for both and they are
the same. The code is the same, with the exception of the ranges used and
one does have an added code for placing check marks in a specified range, but
the code for the calendar is the same in both.
Here is the code that is in the worksheet that makes the calendar smaller:
Private Sub Calendar1_Click()
ActiveCell.Value = CDbl(Calendar1.Value)
ActiveCell.NumberFormat = "ddd mm/dd"
ActiveCell.Select
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("A5:A1520"), Target) Is Nothing Then
Calendar1.Left = Target.Left + Target.Width - Calendar1.Width
Calendar1.Top = Target.Top + Target.Height
Calendar1.Visible = True
' select Today's date in the Calendar
Calendar1.Value = Date
ElseIf Calendar1.Visible Then Calendar1.Visible = False
End If
End Sub
On several other worksheets this code works fine and has been for a couple
of years.
Here is the code from the worksheet that makes the calendar bigger:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("D4500,J4:J500,M4:M500"), Target)
Is Nothing Then
Calendar1.Left = Target.Left + Target.Width - Calendar1.Width
Calendar1.Top = Target.Top + Target.Height
Calendar1.Visible = True
' select Today's date in the Calendar
Calendar1.Value = Date
ElseIf Calendar1.Visible Then Calendar1.Visible = False
End If
Application.EnableEvents = False
On Error GoTo sub_exit
If Not Intersect(Target, Range("Checks")) Is Nothing Then
With Target
If .Value = "P" Then
.Value = ""
Else
.Value = "P"
.Font.Name = "Wingdings 2"
End If
End With
End If
sub_exit:
Application.EnableEvents = True
End Sub
Private Sub Calendar1_Click()
ActiveCell.Value = CDbl(Calendar1.Value)
ActiveCell.NumberFormat = "ddd mmm dd"
ActiveCell.Select
End Sub
This code is particular to this one worksheet because I needed the
checkmarks and combined the two macros (cobbled as it may be it does the job).
Any help/direction would be appreciated
Mike Rogers