PDA

View Full Version : Solved: Date Time Picker



jec3300
05-03-2006, 05:12 AM
I have a program that I have created that has 3 date time picker buttons in it. The problem that I am having is there are times when two of then are set to not enabled. This is only done when certain option buttons are selected. This is fine but the dates of these two date time picker buttons are still showing up in my excel sheet. Is there a way so that when these two buttons are not enabled to not show the date for these two in the excel sheet?

As a side note. I am new to this forum and am glad that I found it, so I would like to say :hi:

Thanks for all of your help
</IMG>

ALe
05-03-2006, 05:43 AM
Can you attach a sample file?

jec3300
05-03-2006, 06:06 AM
This is one area of my code.


Private Sub optDxm_Change()
If optDxm = False Then
DTPicker2.Enabled = True
DTPicker3.Enabled = True
End If
End Sub
------------------------------------------------------
Private Sub optDxm_Click()
If optDxm = True Then
optDxmType = True
optPlmType.Enabled = False
optTranslation = False
optTranslationType = False
optTranslationType.Enabled = False
optDxmType.Enabled = True
optUnfoldType.Enabled = False
optStampedBeam.Enabled = False
optBumpers.Enabled = False
optTubular.Enabled = False
optStampings.Enabled = False
optIp.Enabled = False
DTPicker2.Enabled = False
DTPicker3.Enabled = False
Else
optDxm = False
optTranslationType.Enabled = True
optPlmType.Enabled = True
optDxmType.Enabled = True
optUnfoldType.Enabled = True
optStampedBeam.Enabled = True
optBumpers.Enabled = True
optTubular.Enabled = True
optStampings.Enabled = True
optIp.Enabled = True
End If
End Sub

lucas
05-03-2006, 06:13 AM
Hi Jec3300,
could you post the entire code for the form or attach a workbook to your post. I have enclosed your code in vba tags for easier reading in the previous post. We need to see your initialize code at least....

jec3300
05-03-2006, 06:16 AM
Option Explicit
Sub create_variable()
Dim txtDescription As String * 80
Dim txtErn As String
Dim cboDesigner As String
Dim txtEngineer As String
Dim txtHours As Integer
Dim DTPicker2 As Date
Dim DTPicker3 As Date
Dim DTPicker1 As Date
End Sub
Private Sub cmdClear_Click()
Call UserForm_Initialize
End Sub
Private Sub cmdEdit_Click()
ActiveWorkbook.Sheets("DESIGNER").Activate
Unload Me
End Sub
Private Sub cmdExit_Click()
Unload Me
Workbooks("capacity2006.xls").Save
Workbooks.Application.Quit
End Sub


Private Sub cmdInsert_Click()
ActiveWorkbook.Sheets("DESIGNER").Activate
Range("B1").Select
' checks to see that all boxes are filled in
If txtErn.Text = "" Then
MsgBox ("Enter ERN Number or N/A")
Exit Sub
End If

If cboDesigner.Text = "" Then
MsgBox ("Select Designer Name")
Exit Sub
End If

If txtProjectNumber.Text = "" Then
MsgBox ("Enter Project Number or N/A")
Exit Sub
End If

If txtEngineer.Text = "" Then
MsgBox ("Enter Engineers Last Name")
Exit Sub
End If

If txtHours.Text = "" Then
MsgBox ("Enter Total Hours Worked")
Exit Sub
End If


If txtDescription.Text = "" Then
MsgBox ("Enter Description of Work")
Exit Sub
End If
If optCatiaV4.Value = False And optCatiaV5.Value = False And optSdrc.Value = False _
And optUg.Value = False And optTranslation.Value = False And optPlm.Value = False _
And optDxm.Value = False And optBlankUnfold.Value = False Then
MsgBox ("Enter System")
Exit Sub
End If
If optStampedBeam.Value = False And optBumpers.Value = False And optTubular.Value = False _
And optStampings.Value = False And optIp.Value = False And optTranslationType.Value = False _
And optPlmType.Value = False And optDxmType.Value = False And optUnfoldType.Value = False Then
MsgBox ("Enter Type of Work")
Exit Sub
End If


' this is for the system button box
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
If optCatiaV4 = True Then
ActiveCell.Value = "V4"
ElseIf optCatiaV5 = True Then
ActiveCell.Value = "V5"
ElseIf optSdrc = True Then
ActiveCell.Value = "SDRC"
ElseIf optUg = True Then
ActiveCell.Value = "UG"
ElseIf optTranslation = True Then
ActiveCell.Value = "TRANSLATION"
ElseIf optPlm = True Then
ActiveCell.Value = "PLM"
ElseIf optDxm = True Then
ActiveCell.Value = "DXM"
ElseIf optBlankUnfold = True Then
ActiveCell.Value = "UN-FOLDING"
Else
ActiveCell.Value = ""
End If
'inserts all of the text box selections into the form
ActiveCell.Offset(0, 1) = txtErn.Value
ActiveCell.Offset(0, 2) = cboDesigner.Value
ActiveCell.Offset(0, 3) = txtProjectNumber.Value
ActiveCell.Offset(0, 4) = txtEngineer.Value
ActiveCell.Offset(0, 6) = txtHours.Value
ActiveCell.Offset(0, 7) = DTPicker1
ActiveCell.Offset(0, 8) = DTPicker2
ActiveCell.Offset(0, 9) = DTPicker3
ActiveCell.Offset(0, 10) = txtDescription.Value

' adds the work type selection to the form
If optStampedBeam = True Then
ActiveCell.Offset(0, 11).Value = "STAMPED-BEAM"
ElseIf optBumpers = True Then
ActiveCell.Offset(0, 11).Value = "BUMPERS"
ElseIf optTubular = True Then
ActiveCell.Offset(0, 11).Value = "TUBULAR-BEAMS"
ElseIf optStampings = True Then
ActiveCell.Offset(0, 11).Value = "STAMPINGS"
ElseIf optIp = True Then
ActiveCell.Offset(0, 11).Value = "I/P"
ElseIf optTranslationType = True Then
ActiveCell.Offset(0, 11).Value = "Translations"
ElseIf optPlmType = True Then
ActiveCell.Offset(0, 11).Value = "PLM"
ElseIf optDxmType = True Then
ActiveCell.Offset(0, 11).Value = "DXM"
ElseIf optUnfoldType = True Then
ActiveCell.Offset(0, 11).Value = "UNFOLDING"
Else
ActiveCell.Offset(0, 11).Value = ""
End If


ThisWorkbook.Save

End Sub


Private Sub DTPicker2_CallbackKeyDown(ByVal KeyCode As Integer, _
ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)
End Sub
Private Sub optBlankUnfold_Change()
If optBlankUnfold = False Then
DTPicker2.Enabled = True
DTPicker3.Enabled = True
End If
End Sub
Private Sub optBlankUnfold_Click()
If optBlankUnfold = True Then
optUnfoldType = True
optPlmType.Enabled = False
optTranslation = False
optTranslationType = False
optTranslationType.Enabled = False
optDxmType.Enabled = False
optUnfoldType.Enabled = True
optStampedBeam.Enabled = False
optBumpers.Enabled = False
optTubular.Enabled = False
optStampings.Enabled = False
optIp.Enabled = False
DTPicker2.Enabled = False
DTPicker3.Enabled = False

Else
optBlankUnfold = False
optTranslationType.Enabled = True
optPlmType.Enabled = True
optDxmType.Enabled = True
optUnfoldType.Enabled = True
optStampedBeam.Enabled = True
optBumpers.Enabled = True
optTubular.Enabled = True
optStampings.Enabled = True
optIp.Enabled = True
End If
End Sub
Private Sub optCatiaV4_Click()
' turns off all none cad work types
If optCatiaV4 = True Then
optTranslation = False
optTranslationType = False
optPlmType = False
optPlmType.Enabled = False
optTranslationType.Enabled = False
optDxmType.Enabled = False
optDxmType = False
optUnfoldType.Enabled = False
optUnfoldType = False
optStampedBeam.Enabled = True
optBumpers.Enabled = True
optTubular.Enabled = True
optStampings.Enabled = True
optIp.Enabled = True
Else
optCatiaV4 = False
optTranslationType.Enabled = True
optPlmType.Enabled = True
optDxmType.Enabled = True
optUnfoldType.Enabled = True
optStampedBeam.Enabled = True
optBumpers.Enabled = True
optTubular.Enabled = True
optStampings.Enabled = True
optIp.Enabled = True
End If
End Sub
Private Sub optCatiaV5_Click()
' turns off all none cad work types
If optCatiaV5 = True Then
optTranslation = False
optTranslationType = False
optPlmType.Enabled = False
optPlmType = False
optTranslationType.Enabled = False
optDxmType.Enabled = False
optDxmType = False
optUnfoldType.Enabled = False
optUnfoldType = False
optStampedBeam.Enabled = True
optBumpers.Enabled = True
optTubular.Enabled = True
optStampings.Enabled = True
optIp.Enabled = True
Else
optCatiaV5 = False
optTranslationType.Enabled = True
optPlmType.Enabled = True
optDxmType.Enabled = True
optUnfoldType.Enabled = True
optStampedBeam.Enabled = True
optBumpers.Enabled = True
optTubular.Enabled = True
optStampings.Enabled = True
optIp.Enabled = True
End If
End Sub
Private Sub optDxm_Change()
If optDxm = False Then
DTPicker2.Enabled = True
DTPicker3.Enabled = True
End If
End Sub
Private Sub optDxm_Click()
If optDxm = True Then
optDxmType = True
optPlmType.Enabled = False
optTranslation = False
optTranslationType = False
optTranslationType.Enabled = False
optDxmType.Enabled = True
optUnfoldType.Enabled = False
optStampedBeam.Enabled = False
optBumpers.Enabled = False
optTubular.Enabled = False
optStampings.Enabled = False
optIp.Enabled = False
DTPicker2.Enabled = False
DTPicker3.Enabled = False
Else
optDxm = False
optTranslationType.Enabled = True
optPlmType.Enabled = True
optDxmType.Enabled = True
optUnfoldType.Enabled = True
optStampedBeam.Enabled = True
optBumpers.Enabled = True
optTubular.Enabled = True
optStampings.Enabled = True
optIp.Enabled = True
End If
End Sub
Private Sub optPlm_Change()
If optPlm = False Then
DTPicker2.Enabled = True
DTPicker3.Enabled = True
End If
End Sub
Private Sub optPlm_Click()
If optPlm = True Then
optPlmType.Enabled = True
optPlmType = True
optTranslation = False
optTranslationType = False
optTranslationType.Enabled = False
optDxmType.Enabled = False
optUnfoldType.Enabled = False
optStampedBeam.Enabled = False
optBumpers.Enabled = False
optTubular.Enabled = False
optStampings.Enabled = False
optIp.Enabled = False
DTPicker2.Enabled = False
DTPicker3.Enabled = False

Else
optPlm = False
optTranslationType.Enabled = True
optPlmType.Enabled = True
optDxmType.Enabled = True
optUnfoldType.Enabled = True
optStampedBeam.Enabled = True
optBumpers.Enabled = True
optTubular.Enabled = True
optStampings.Enabled = True
optIp.Enabled = True

End If

End Sub
Private Sub optSdrc_Click()
' turns off all none cad work types
If optSdrc = True Then
optTranslation = False
optTranslationType = False
optPlmType.Enabled = False
optPlmType = False
optTranslationType.Enabled = False
optDxmType.Enabled = False
optDxmType = False
optUnfoldType.Enabled = False
optUnfoldType = False
optStampedBeam.Enabled = True
optBumpers.Enabled = True
optTubular.Enabled = True
optStampings.Enabled = True
optIp.Enabled = True
Else
optSdrc = False
optTranslationType.Enabled = True
optPlmType.Enabled = True
optDxmType.Enabled = True
optUnfoldType.Enabled = True
optStampedBeam.Enabled = True
optBumpers.Enabled = True
optTubular.Enabled = True
optStampings.Enabled = True
optIp.Enabled = True
End If
End Sub
Private Sub optTranslation_Change()
If optTranslation = False Then
DTPicker2.Enabled = True
DTPicker3.Enabled = True
End If

End Sub
Private Sub optTranslation_Click()
' if translation is selected in the system area then translation
' will be active in the type area
If optTranslation = True Then
optTranslationType.Enabled = True
optTranslationType = True
optPlmType.Enabled = False
optDxmType.Enabled = False
optUnfoldType.Enabled = False
optStampedBeam.Enabled = False
optBumpers.Enabled = False
optTubular.Enabled = False
optStampings.Enabled = False
optIp.Enabled = False
DTPicker2.Enabled = False
DTPicker3.Enabled = False

Else
optTranslation = False
optTranslationType.Enabled = True
optPlmType.Enabled = True
optDxmType.Enabled = True
optUnfoldType.Enabled = True
optStampedBeam.Enabled = True
optBumpers.Enabled = True
optTubular.Enabled = True
optStampings.Enabled = True
optIp.Enabled = True

End If
End Sub

Private Sub optTranslationType_Click()
End Sub
Private Sub optUg_Click()
' turns off all none cad work types
If optUg = True Then
optTranslation = False
optTranslationType = False
optPlmType.Enabled = False
optPlmType = False
optTranslationType.Enabled = False
optDxmType.Enabled = False
optDxmType = False
optUnfoldType.Enabled = False
optUnfoldType = False
optStampedBeam.Enabled = True
optBumpers.Enabled = True
optTubular.Enabled = True
optStampings.Enabled = True
optIp.Enabled = True
Else
optUg = False
optTranslationType.Enabled = True
optPlmType.Enabled = True
optDxmType.Enabled = True
optUnfoldType.Enabled = True
optStampedBeam.Enabled = True
optBumpers.Enabled = True
optTubular.Enabled = True
optStampings.Enabled = True
optIp.Enabled = True
End If
End Sub


Private Sub UserForm_Initialize()
'sets all values to clear
txtErn.Value = ""
txtProjectNumber.Value = ""
txtEngineer.Value = ""
txtDescription.Value = ""
txtHours.Value = ""
optCatiaV4 = False
optCatiaV5 = False
optSdrc = False
optUg = False
optTranslation = False
optDxm = False
optPlm = False
optBlankUnfold = False
optTranslationType = False
optPlmType = False
optDxmType = False
optUnfoldType = False
optStampedBeam = False
optBumpers = False
optTubular = False
optStampings = False
optIp = False
optTranslationType.Enabled = True
optPlmType.Enabled = True
optDxmType.Enabled = True
optUnfoldType.Enabled = True
optStampedBeam.Enabled = True
optBumpers.Enabled = True
optTubular.Enabled = True
optStampings.Enabled = True
optIp.Enabled = True
With cboDesigner
.AddItem "JIMC"
.AddItem "ERIK"
.AddItem "AARON"
.AddItem "JIRI"
End With
cboDesigner.Value = ""
ActiveWorkbook.Sheets("sheet1").Activate
Range("B1").Select
DTPicker1.Value = Now
DTPicker2.Value = Now
DTPicker3.Value = Now

End Sub

lucas
05-03-2006, 06:48 AM
Please use the vba button to enclose your code in vba tags when you post code. Makes it a lot easier to read.
Looks like your setting the value to now in the initialize statement and
Private Sub UserForm_Initialize()
DTPicker1.Value = Now
DTPicker2.Value = Now
DTPicker3.Value = Now

then setting it to that value in the button click....
Private Sub cmdInsert_Click()
ActiveCell.Offset(0, 7) = DTPicker1
ActiveCell.Offset(0, 8) = DTPicker2
ActiveCell.Offset(0, 9) = DTPicker3
Its really difficult to understand what is going on here without the form and its a lot to ask for someone to recreate your form just to answer your questions....can you not remove any sensitive data and post the file so we can see what is going on with the buttons, etc.?

jec3300
05-03-2006, 06:56 AM
Sorry, I guess that I need to look at the icons. I have attached a copy of my file. Hope this helps

ALe
05-03-2006, 08:02 AM
as far as i know you can't assign zero to the calendar control. You can hide it such as:

If Me.DTPicker2.Enabled = False Then
Me.DTPicker2.Visible = False
Me.Label7.Visible = False
Me.DTPicker3.Visible = False
Me.Label8.Visible = False
End If

jec3300
05-03-2006, 08:29 AM
ALe, Thank you for your reply, I have tried your suggestion and no luck. It is still added the dates to the cells. I am thinking about trying code that will look at the cells in question and removing the dates when those two date time pickers are turned off.

jec3300
05-03-2006, 08:37 AM
I have it figured out, I added these lines of code and fixed the problem:


If DTPicker2.Enabled = False Then
ActiveCell.Offset(0, 8) = ""
End If

If DTPicker3.Enabled = False Then
ActiveCell.Offset(0, 9) = ""
End If

lucas
05-03-2006, 08:48 PM
Glad you got it sorted out and thanks for posting your solution..