View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default Cant set the date into a Date & Time Picker from Cell value

The only way I could break your code is if there wasn't a real date in that
column. But I didn't get the error message you wrote.

This may not help at all, but maybe checking to see if there's a date in that
cell would be a good thing.

My little test code:

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
Cancel = True 'stop editing of cell
With UserForm1
.DTPicker1.Value = Date 'default to today??
If Not IsEmpty(Me.Cells(Target.Row, "S").Value) Then
If IsDate(Me.Cells(Target.Row, "S").Value) Then
.DTPicker1.Value = Me.Cells(Target.Row, "S").Value
End If
End If
.Show
End With
End Sub


RyanH wrote:

I have a cell that reads "9/8/08". It is formatted as a date. I also have a
Userform. The control values are set by what is in the cells. For some
reason, I am getting an error on the line indicated below; "An error occured
in a call to the Window Date & Time Picker Control." I have the DTPicker
controls Format = 1 dtpShortDate. Anybody have any ideas?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)

'autofills the user form with the data from global schedule worksheet
Cancel = True

With frmSalesSummary
.txbItemNumber = Cells(Target.Row, "A")
On Error Resume Next
.cboProductCode = Cells(Target.Row, "B")
.cboSalesPerson = Cells(Target.Row, "C")
.cboEngineer = Cells(Target.Row, "D")
On Error GoTo 0
.txbCustomer = Cells(Target.Row, "E")
.txbEndUser = Cells(Target.Row, "F")
.txbQty = Cells(Target.Row, "G")
.txbDescription1 = Cells(Target.Row, "H")
.txbDescription2 = Cells(Target.Row, "I")
.txbComments = Cells(Target.Row, "J")
On Error Resume Next
.cboShipMethod = Cells(Target.Row, "K")
.cboStatus = Cells(Target.Row, "L")
On Error GoTo 0
.dtpScheduledShip = Cells(Target.Row, "M")
.dtpActualShip = Cells(Target.Row, "N")
.txbBOM = Cells(Target.Row, "O")
.txbSalesPrice = Cells(Target.Row, "P")
.txbTotalEstHrs = Cells(Target.Row, "Q")
.txbTotalActHrs = Cells(Target.Row, "R")

' Engineering
If Not IsEmpty(Cells(Target.Row, "S")) Then
ERROR .dtpEngineering.Value = Cells(Target.Row, "S")
.txbEngEstHrs = Cells(Target.Row, "T")
.txbEngActHrs = Cells(Target.Row, "U")
.chkEngineering.Value = True
.chkEngineeringDone.Value = CBool(Cells(Target.Row,
"S").Font.Color)
' Call chkEngineering_Click
End If

End With

frmSalesSummary.Show

End Sub
--
Cheers,
Ryan


--

Dave Peterson