Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count 1 Then Exit Sub
On Error Goto ErrorHandler
If Not
Application.Intersect(Range("D11,E20,E65,G30,D30,D 33,D54,H71"), _
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
Exit Sub

ErrorHandler:
If Err.Number = 'Number you get when it's broke Then
MsgBox "If the PopUp Calendar does not work have a look to the
HELP SHEET"
Sheets("Help Sheet").Activate
Else
Err.Raise
End If

On Error Goto 0
End Sub


Charles

Drahos wrote:
Hi Charles,
thank you very much for your reply and help. I am not so good to aply
your advice to my Code. I copy it and I would like to ask you to help me
again to put a new error message to this Code.

Private Sub Calendar1_Click()
ActiveCell.Value = CDbl(Calendar1.Value)
ActiveCell.NumberFormat = "mmmm d, yyyy"
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("D11,E20,E65,G30,D30,D 33,D54,H71"),
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

I would like to have the error message like this:
Text = MsgBox("If the PopUp Calendar does not work have a look to the HELP
SHEET")

Best Regards
Drahos

"Die_Another_Day" wrote:

Sub YourSub()
On Error Goto ErrorHandler
'Your code
Exit Sub
ErrorHandler:
if Err.Number = 'Known Erro Number Then
'Your Msg
Else
Err.Raise
End If
On Error Goto 0
End Sub

Charles Chickering

Drahos wrote:
Hi all,
I have a sheet where I use a sheet code with the macro to use Calendar
Object. This sheet is supposed to be used by a lot of other users. If a used
has not the Calendar object on its PC installed than this macro shows an
error and error message. I need to replace this system message by my own
message instructing a user that it is necessary to install/activate the
calendar objet. Is it possible?
Thanks a lot for any help.
Drahos.