Date & Time Picker Properties Question

R

RyanH

I am building a production schedule UserForm, which has 15 departments, and
by each department label I included a DTPicker Control. This way my users
can select the due of each department for a particular product. My question
is this, is there a way to clear the out the date in the drop down box so no
date shows? I have cleared the date under the Value Property box, but when I
intialize the UserForm the DTPicker Control displays todays date, I guess by
default? If you have any other ways around this I would greatly appreciate
it, because I think the UserForm looks to busy, with all the dates displayed
even though the CheckBox = False.

Note: I'm using Excel 2003, Microsoft Date & Time Picker Control 6.0 (SP4)

Additonally,

I set the DTPicker Control CheckBox Property to True (so a checkbox is
displayed next to the date in the drop down box). I also have two textboxes
next to each DTPicker Control. I would like to know if there is a way set
the Visible Property of the two textboxes to False next to the Picker Control
if the Picker Controls Checkbox is not checked. For example:

Private Sub dtpEngineer_Click()

dtpEngineer.CheckBox.Value = TextBox1.Visible
dtpEngineer.CheckBox.Value = TextBox2.Visible

End Sub
 
R

Rick Rothstein \(MVP - VB\)

That means you have 15 DTPicker Controls, right? Okay, you will have to set some event procedures up individually for each of the 15 DTPicker Controls you have. First, here is the common routines (that is, you only need one of each of these)...

' ***** Start Common Procedures *****
Private Sub FormatDTPicker(PickerControl As DTPicker)
With PickerControl
If .Value = vbNull Then
.Format = dtpCustom
.CustomFormat = "X"
Else
.Format = dtpShortDate
End If
End With
End Sub

Private Sub UserForm_Initialize()
Dim Ctrl As Control
For Each Ctrl In Me.Controls
If TypeName(Ctrl) = "DTPicker" Then
Ctrl.Value = vbNull
FormatDTPicker Ctrl
End If
Next
End Sub
' ***** End Common Procedures *****

Next, you need one of each of the following procedures for **each** DTPicker Control that you have **AND** you have to change the control name references inside each of these procedures to match the actual control's name. Here are the procedures you need for DTPicker1....

' ***** Start Procedures For DTPicker1 Control *****
Private Sub DTPicker1_CloseUp()
FormatDTPicker DTPicker1
End Sub

Private Sub DTPicker1_Format(ByVal CallbackField As String, _
FormattedString As String)
If CallbackField = "X" Then
FormattedString = ""
End If
End Sub

Private Sub DTPicker1_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As stdole.OLE_XPOS_PIXELS, _
ByVal Y As stdole.OLE_YPOS_PIXELS)
With DTPicker1
If .Value = vbNull Then
.Value = Now
End If
End With
End Sub
' ***** End Procedures For DTPicker1 Control *****

Now, you have to duplicate the above 3 sets of event procedures for each DTPicker Control you have. After you have done that, the DTPicker Controls will all be blank when the UserForm is first loaded. Afterwards, if you want to blank any single DTPicker Control, just set the Value property of that DatePicker Control to vbNull and then call the FormatDTPicker subroutine passing in the name (not a text string of the name, but the name itself). So, for example, if you wanted to blank out just the DTPicker5 control, you would execute these two lines of code...

DTPicker5.Value = vbNull
FormatDTPicker DTPicker5

The above is adapted from code I developed and have posted in the compiled VB newsgroups over the years. This is easier to do in compiled VB because one can bundle controls into something called a Control Array; all control in an Control Array share the same event procedures and, hence, all of the above duplications you have to do for each DTPicker Control above is avoided in compiled VB. However, I did try out what I have posted for you to do on a limited set of DTPicker Controls situated on a UserForm and the code does work.

Rick
 
J

Jim Thomlinson

Thanks for your insights. I never knew you could blank out a Date & Time
picker... While I have no immediate need for that little bit of coding genius
I will keep it in mind for next time... Very handy for keeping the UI clean...
 
R

Rick Rothstein \(MVP - VB\)

And thank you for your compliment. I remember well the aggravation and hair pulling (not much of that to spare since I am bald<g>) that I went through while trying to figure out how to make that control work the way I wanted it to. The documentation was not as obvious about it as I would have liked.

Rick
 
J

Jim Thomlinson

I'm not bald yet but I know the one time I tried I grew a little more
forehead that day...
 
D

Dave Peterson

I think that there was a mistake with the picture. I _think_ that's Steve
Ballmer <vbg>.
 
R

Rick Rothstein \(MVP - VB\)

LOL

Yeah, I'll concede that one to you... his wallet is just a **wee** bit larger than mine.<g>

Rick
 
R

RyanH

I hope this replys to all. Thanks for getting back to me with that code.
But I am having an issue with initalizing the UserForm the way I need it too.
Let me explain my old setup before your code.

My old UserForm had a TextBox next to each department. The user would
double click the cell the Sales Order # was contained in and the UserForm
would Intialize. When it was Intialized the macro would scan down the row
that was double clicked and fill the due dates of each department. If there
wasn't a date the textbox was left blank.

Is there a way to do this with the DTPicker? In other words, when the
UserForm is Initialized if the cell that stores the due date for that
department is blank have the DTPicker Control Value display blank and when
there is a date have the DTPicker Control Value display that date. Is this
possible?

Thanks in advanced!!
 
R

RyanH

I hope this replys to all. Thanks for getting back to me with that code.
But I am having an issue with initalizing the UserForm the way I need it too.
Let me explain my old setup before your code.

My old UserForm had a TextBox next to each department. The user would
double click the cell the Sales Order # was contained in and the UserForm
would Intialize. When it was Intialized the macro would scan down the row
that was double clicked and fill the due dates of each department. If there
wasn't a date the textbox was left blank.

Is there a way to do this with the DTPicker? In other words, when the
UserForm is Initialized if the cell that stores the due date for that
department is blank have the DTPicker Control Value display blank and when
there is a date have the DTPicker Control Value display that date. Is this
possible?

Thanks in advanced!!
 
R

Rick Rothstein \(MVP - VB\)

Yes, it is possible to do that. Since you didn't post any code, I can only guess at how to direct you to incorporate my routine into it, but let me try (you should try what I am about to suggest to a copy of your spreadsheet so as not to mess it up in case something goes wrong in how you follow my instructions). First of all, you will need to set up everything I posted earlier **except** for the UserForm Initialize event procedure (we will use what you have as a base for that event). Once you have added the 3 event procedures for each of your 15 TextBoxes and added the FormatDTPicker subroutine, then in your UserForm Initialize event, wherever you now assign the date to a TextBox, you will need to do this instead... if the cell you are retrieving your date from is a date, assign it to the Value property for the DTPicker Control that corresponds to that cell... else, if the cell is blank, execute these two lines

DTPicker5.Value = vbNull
FormatDTPicker DTPicker5

where you would be using the name of the DTPicker Control that corresponds to that cell in place of the DTPicker5 name I used in these sample code lines above. Hopefully, that makes sense to you. If you have any trouble, it would be helpful if you posted your existing DoubleClick event code and your UserForm Initialize event code for us to look at.

Rick
 
R

RyanH

I removed the For Each Loop from the Inialize Event like you said and I am
getting an error Sub or Function not defined. I currently use the
BeforeDoubleClick Event to load my UserFrom. There could be a better way of
doing this but I'm just not sure how since I am new to VBA.
Here is my code and where they are located:

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

Cancel = True

ActiveSheet.Cells(ActiveCell.Row, "A").Select

With frmSalesSummary
.txbSalesOrder = Cells(ActiveCell.Row, "A")
On Error Resume Next
.cboSalesPerson = Cells(ActiveCell.Row, "B")
On Error Resume Next
.cboEngineer = Cells(ActiveCell.Row, "C")
.txbCustomer = Cells(ActiveCell.Row, "D")
.txbEndUser = Cells(ActiveCell.Row, "E")
.txbQty = Cells(ActiveCell.Row, "F")
.txbDescription1 = Cells(ActiveCell.Row, "G")
.txbDescription2 = Cells(ActiveCell.Row, "H")
.txbComments = Cells(ActiveCell.Row, "I")
On Error Resume Next
.cboShipMethod = Cells(ActiveCell.Row, "J")

If Cells(ActiveCell.Row, "K") = "" Then
.dtpScheduledShip.Value = ""
Else
.dtpScheduledShip.Value = Cells(ActiveCell.Row, "K")
End If

If Cells(ActiveCell.Row, "L") = "" Then
.dtpActualShip.Value = ""
Else
.dtpActualShip.Value = Cells(ActiveCell.Row, "L")
End If

.txbBOM = Cells(ActiveCell.Row, "M")
.txbSalesPrice = Cells(ActiveCell.Row, "N")
.txbTotalEstHrs = Cells(ActiveCell.Row, "O").Text
.txbTotalActHrs = Cells(ActiveCell.Row, "P").Text

'ENGINEERING: Code recognizes font in grey thus activates associated
checkbox, if black font does deactivates.
If IsDate(Cells(ActiveCell.Row, "Q")) = True Then
.dtpEngineer.Value = Cells(ActiveCell.Row, "Q").Text
Else
dtpEngineer.Value = vbNull
FormatDTPicker dtpEngineer <===ERROR ERROR
End If

.txbEngEstHrs = Cells(ActiveCell.Row, "R").Text
.txbEngActHrs = Cells(ActiveCell.Row, "S").Text

If Cells(ActiveCell.Row, "Q").Font.ColorIndex = 15 Then
.dtpEngineer.Enabled = False
.chkEngineering = True
Else
.dtpEngineer.Enabled = True
.chkEngineering = False
End If

*****There are fourteen more departments coded the same way as ENGINEERING
just with different names.

frmSalesSummary.Show

End Sub

At this point I have probably managed to confuse you. Do you have enough
information from me to determine the issue? Thanks agian for your help on
this!!
 
R

Rick Rothstein \(MVP - VB\)

Since you are trying to reference the FormatDTPicker subroutine that is
located on the UserForm, you have to do two things. First, change the
declaration for the FormatDTPicker subroutine from Private to Public so it
can be seen outside of the UserForm (you are executing your code from the
Worksheet's BeforeDoubleClick event, so procedures declared Private on the
UserForm can't be seen there). Second, you have to use
UserForm1.FormatDTPicker instead of just FormatDTPicker in code line where
your error is happening at (you need to point to tell VBA where it can find
the FormatDTPicker subroutine at). The issues we have been talking about are
known as "scope" and deal with where things are located and the access
restrictions that apply to them.

By the way... one On Error Resume Next statement is all you need in a single
procedure... it will remain in effect from the moment the statement is
executed until an On Error Goto 0 statement is issued or until you exit the
procedure, whichever comes first.

Rick
 
R

RyanH

Thanks for the tip and the through explanation of everything! Ok, let me
verify everything I have done, because now I am getting a different Error -
"ByRef arguement type mismatch". Here is where I put everything:


********UserForm Code**************
Public Sub FormatDTPicker(PickerControl As DTPicker)

With PickerControl
If .Value = vbNull Then
.Format = dtpCustom
.CustomFormat = "X"
Else
.Format = dtpShortDate
End If
End With

End Sub


Private Sub dtpEngineer_CloseUp()

FormatDTPicker dtpEngineer

End Sub

Private Sub dtpEngineer_Format(ByVal CallbackField As String,
FormattedString As String)

If CallbackField = "X" Then
FormattedString = ""
End If

End Sub


Private Sub dtpEngineer_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As stdole.OLE_XPOS_PIXELS, _
ByVal Y As stdole.OLE_YPOS_PIXELS)
With dtpEngineer
If .Value = vbNull Then
.Value = Now
End If
End With

End Sub


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

Cancel = True

ActiveSheet.Cells(ActiveCell.Row, "A").Select

With frmSalesSummary
.txbSalesOrder = Cells(ActiveCell.Row, "A")
On Error Resume Next
.cboSalesPerson = Cells(ActiveCell.Row, "B")
.cboEngineer = Cells(ActiveCell.Row, "C")
.txbCustomer = Cells(ActiveCell.Row, "D")
.txbEndUser = Cells(ActiveCell.Row, "E")
.txbQty = Cells(ActiveCell.Row, "F")
.txbDescription1 = Cells(ActiveCell.Row, "G")
.txbDescription2 = Cells(ActiveCell.Row, "H")
.txbComments = Cells(ActiveCell.Row, "I")
.cboShipMethod = Cells(ActiveCell.Row, "J")

If Cells(ActiveCell.Row, "K") = "" Then
.dtpScheduledShip.Value = ""
Else
.dtpScheduledShip.Value = Cells(ActiveCell.Row, "K")
End If

If Cells(ActiveCell.Row, "L") = "" Then
.dtpActualShip.Value = ""
Else
.dtpActualShip.Value = Cells(ActiveCell.Row, "L")
End If

.txbBOM = Cells(ActiveCell.Row, "M")
.txbSalesPrice = Cells(ActiveCell.Row, "N")
.txbTotalEstHrs = Cells(ActiveCell.Row, "O").Text
.txbTotalActHrs = Cells(ActiveCell.Row, "P").Text

'Engineering: Code recognizes font in grey thus activates associated
checkbox, if black font does deactivates.
If IsDate(Cells(ActiveCell.Row, "Q")) = True Then
dtpEngineer = Cells(ActiveCell.Row, "Q").Text
Else
dtpEngineer.Value = vbNull
frmSalesSummary.FormatDTPicker dtpEngineer <==ERROR ERROR
End If

.txbEngEstHrs = Cells(ActiveCell.Row, "R").Text
.txbEngActHrs = Cells(ActiveCell.Row, "S").Text

If Cells(ActiveCell.Row, "Q").Font.ColorIndex = 15 Then
.dtpEngineer.Enabled = False
.chkEngineering = True
Else
.dtpEngineer.Enabled = True
.chkEngineering = False
End If

'other departs follow ENGINEERING

frmSalesSummary.Show

End Sub


Thanks for you patience!
 
R

Rick Rothstein \(MVP - VB\)

At the beginning of your Engineering section, you have this code....
If IsDate(Cells(ActiveCell.Row, "Q")) = True Then
dtpEngineer = Cells(ActiveCell.Row, "Q").Text
Else
dtpEngineer.Value = vbNull
frmSalesSummary.FormatDTPicker dtpEngineer '<==ERROR
End If

See those dtpEngineer statements... they need to point back to the user
form. Since you have a With/EndWith statement block surrounding this code
which references that form, you can just put a dot in front of the
DatePicker Control names (like you did with dtpScheduledShip and
dtpActualShip in the code that preceded it). Also, you can remove the direct
reference to the user form for any code within the With/EndWith block (such
as I had you add to the FormatDTPicker subroutine call). Here is the
affected code (from the beginning of the "Engineering: Code" section)
revised in accordance with the above...

If IsDate(Cells(ActiveCell.Row, "Q")) = True Then
.dtpEngineer = Cells(ActiveCell.Row, "Q").Text
Else
.dtpEngineer.Value = vbNull
.FormatDTPicker .dtpEngineer '<==ERROR ERROR
End If

See if putting those changes into effect makes your code work.

Rick
 
R

RyanH

Don't give up on me, lol. You seem to be the only DTPicker expert around
here. Here is what I have just to verify. Good News, I'm not getting any
Errors but the DTPicker is still showing the current date when I double click
the sales order cell.

********USERFORM***********
Private Sub dtpEngineer_CloseUp()

FormatDTPicker dtpEngineer

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub dtpEngineer_Format(ByVal CallbackField As String, _
FormattedString As String)

If CallbackField = "X" Then
FormattedString = ""
End If

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub dtpEngineer_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As stdole.OLE_XPOS_PIXELS, _
ByVal Y As stdole.OLE_YPOS_PIXELS)
With dtpEngineer
If .Value = vbNull Then
.Value = Now
End If
End With

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub FormatDTPicker(PickerControl As DTPicker)

With PickerControl
If .Value = vbNull Then
.Format = dtpCustom
.CustomFormat = "X"
Else
.Format = dtpShortDate
End If
End With

End Sub

*************Sheet1 CODE********************

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

Cancel = True

ActiveSheet.Cells(ActiveCell.Row, "A").Select

With frmSalesSummary
.txbSalesOrder = Cells(ActiveCell.Row, "A")
On Error Resume Next
.cboSalesPerson = Cells(ActiveCell.Row, "B")
.cboEngineer = Cells(ActiveCell.Row, "C")
.txbCustomer = Cells(ActiveCell.Row, "D")
.txbEndUser = Cells(ActiveCell.Row, "E")
.txbQty = Cells(ActiveCell.Row, "F")
.txbDescription1 = Cells(ActiveCell.Row, "G")
.txbDescription2 = Cells(ActiveCell.Row, "H")
.txbComments = Cells(ActiveCell.Row, "I")
.cboShipMethod = Cells(ActiveCell.Row, "J")

If Cells(ActiveCell.Row, "K") = "" Then
.dtpScheduledShip.Value = ""
Else
.dtpScheduledShip.Value = Cells(ActiveCell.Row, "K")
End If

If Cells(ActiveCell.Row, "L") = "" Then
.dtpActualShip.Value = ""
Else
.dtpActualShip.Value = Cells(ActiveCell.Row, "L")
End If

.txbBOM = Cells(ActiveCell.Row, "M")
.txbSalesPrice = Cells(ActiveCell.Row, "N")
.txbTotalEstHrs = Cells(ActiveCell.Row, "O").Text
.txbTotalActHrs = Cells(ActiveCell.Row, "P").Text

'Engineering: Code recognizes font in grey thus activates associated
checkbox, if black font does deactivates.
If IsDate(Cells(ActiveCell.Row, "Q")) = True Then
.dtpEngineer = Cells(ActiveCell.Row, "Q").Text
Else
.dtpEngineer.Value = vbNull
.FormatDTPicker .dtpEngineer
End If

.txbEngEstHrs = Cells(ActiveCell.Row, "R").Text
.txbEngActHrs = Cells(ActiveCell.Row, "S").Text

If Cells(ActiveCell.Row, "Q").Font.ColorIndex = 15 Then
.dtpEngineer.Enabled = False
.chkEngineering = True
Else
.dtpEngineer.Enabled = True
.chkEngineering = False
End If

' other departments coded just like Engineering

frmSalesSummary.Show

End Sub

Just out of curosisty is there a way to control the value of the checkbox
value in the DTPicker?
 
R

Rick Rothstein \(MVP - VB\)

Don't give up on me, lol. You seem to be the only DTPicker expert around
here. Here is what I have just to verify. Good News, I'm not getting any
Errors but the DTPicker is still showing the current date when I double
click
the sales order cell.

I can only test the part of the code dealing directly with the DTPicker
control as I don't have anything else from your workbook set up here. I
pasted your code UserForm code into my user form and pasted this into my
Sheet1 code of a new Workbook....

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
Cancel = True
ActiveSheet.Cells(ActiveCell.Row, "Q").Select
With frmSalesSummary
'Engineering: Code
If IsDate(Cells(ActiveCell.Row, "Q")) = True Then
.dtpEngineer.Value = Cells(ActiveCell.Row, "Q").Text
Else
.dtpEngineer.Value = vbNull
.FormatDTPicker .dtpEngineer
End If
End With
frmSalesSummary.Show
End Sub

and everything works as it should... if there is no date in Column Q of the
row I double-click on, the DTPicker Control comes up blank and, if there is
a date, that date is displayed in the control. I am not sure what to tell
you about why this isn't working for you as I used your code in my test
workbook. If you still can't get it to work, send me your workbook (remove
the NOSPAM stuff from my address) so I can see everything you are using.

As for the CheckBox question... I have never used it, so I am unsure at the
moment how to control it. I'll do some research later today and post back
(probably tomorrow) if I turn anything up. However, I personally see no
reason to use that CheckBox... it seems like a useless option (even without
using my nulling out the date field code), especially in how you are going
to use it. Assuming you don't use the CheckBox... if there is a no date in
the DTPicker Control, then the blank field should be indication enough that
it needs to be filled in; and if there is a date there, a CheckBox showing
that seems redundant.

Rick
 
R

Rick Rothstein \(MVP - VB\)

To all following this thread
==============================
Ryan sent me the spreadsheet via email and I located the problem. Below is
the message I sent back to him via email... it identifies the problem (a
condition I had not considered before) and offers a solution for it. If you
plan on using my routine in the future, you should make note of the what is
written below.

Rick

Okay, I figured out what the problem was... you set a minimum date via the
MinDate property. This was not something I considered when I originally
developed the routine. By the way, I had a lot of trouble finding this
because of your On Error Resume Next statement. That particular error
trapping routine can be very problematic when debugging because it hide
**all** errors, not just the one's you think it is handling. Anyway, once I
removed its action just before the "Engineering" section, all became clear.
Here is what the problem is. In this line...

.dtpEngineer.Value = vbNull

it **looks** like I am setting the Value property of the DatePicker Control
to NULL... that is **not** what it does... it sets the Value property to 1
(which is what the constant is defined as)... you can't set a date to NULL
which is why my code routine is necessary, it goes around that particular
problem. We could assign any numeric value to the Value property, and look
for that value in the FormatDTPicker subroutine, to make the code work, but
my reasoning for using vbNull was that it "looked" like what I was trying to
do via code (null something out) and it represented a date (one day after
date-zero) that was pretty much guaranteed to never be chosen. However, when
you imposed the MinDate condition on the control, it would no longer let me
assign 1 to the Value property because the date represented by 1 (December
31, 1899) is earlier than your MinDate. As a result, what appears to be
happening is that instead of passing the actual control, a NULL was passed
instead; and that screwed up the

If .Value = vbNull Then

test over in the FormatDTPicker subroutine. With this test failing, the Else
condition (assigning the short date format) was executed instead.

Okay, that is the problem; you probably want to know how to work around it.
There are two ways. One way is to remove the MinDate restiction and set it
back to 12/30/1899. The second way requires that we add two more event
handlers for **each** DatePicker Control you have (15 if I remember the
number correctly). Adding these event handlers (changing the control name
from my sample name to each control's individual names) will solve the
problem...

Private Sub dtpEngineer_Enter()
dtpEngineer.MinDate = "1/1/2007"
End Sub

Private Sub dtpEngineer_Exit(ByVal Cancel As MSForms.ReturnBoolean)
dtpEngineer.MinDate = "12/30/1899"
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top