Calendar control code

[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

 

[Ron de Bruin]

Hi Mike

Is your Zoom different in that workbook

Sometimes if that is true this will help
Deltee the control
Save the file
Add the control
Save the file

 

[Mike Rogers]

Ron

Did the Delete code & control>Save>Close>Reopen>Added code and control and
it still has the problem. Here is what I found. Upon placing the control
its properties said it was 138.75 x 307.5. Saved>closed>reopened 5 times.
After the fifth time the control properties said it was now 425.75 X 930.75.
Did not try the other worksheet because it gets smaller (whereas this one
gets larger) at a much slower rate & it is easier to live with. Zoom was
125% each time I opened/closed and remains the same now. Is it possible to
add code to keep the control about the 138.75 X 307.75 size?

Thanks for your time

Mike Rogers

 

[Mike Rogers]

Ron

The zoom is the same on both, but I will try your suggestion and post back.

I was thinking about addiing the necessary code to have the control be the
same size upon opening......

I'll give it a try and post back, Thanks

Mike Rogers