Consulting

Results 1 to 11 of 11

Thread: Solved: Date Time Picker

  1. #1
    VBAX Regular
    Joined
    May 2006
    Posts
    9
    Location

    Question Solved: Date Time Picker

    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

    Thanks for all of your help
    </IMG>

  2. #2
    VBAX Mentor ALe's Avatar
    Joined
    Aug 2005
    Location
    Milan
    Posts
    383
    Location
    Can you attach a sample file?

  3. #3
    VBAX Regular
    Joined
    May 2006
    Posts
    9
    Location
    This is one area of my code.

    [VBA]
    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
    [/VBA]

  4. #4
    Moderator VBAX Wizard lucas's Avatar
    Joined
    Jun 2004
    Location
    Tulsa, Oklahoma
    Posts
    7,323
    Location
    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....
    Steve
    "Nearly all men can stand adversity, but if you want to test a man's character, give him power."
    -Abraham Lincoln

  5. #5
    VBAX Regular
    Joined
    May 2006
    Posts
    9
    Location
    [vba]
    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[/vba]

  6. #6
    Moderator VBAX Wizard lucas's Avatar
    Joined
    Jun 2004
    Location
    Tulsa, Oklahoma
    Posts
    7,323
    Location
    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 [VBA]
    Private Sub UserForm_Initialize()
    DTPicker1.Value = Now
    DTPicker2.Value = Now
    DTPicker3.Value = Now
    [/VBA]
    then setting it to that value in the button click....
    [VBA]Private Sub cmdInsert_Click()
    ActiveCell.Offset(0, 7) = DTPicker1
    ActiveCell.Offset(0, 8) = DTPicker2
    ActiveCell.Offset(0, 9) = DTPicker3[/VBA]
    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.?
    Steve
    "Nearly all men can stand adversity, but if you want to test a man's character, give him power."
    -Abraham Lincoln

  7. #7
    VBAX Regular
    Joined
    May 2006
    Posts
    9
    Location
    Sorry, I guess that I need to look at the icons. I have attached a copy of my file. Hope this helps

  8. #8
    VBAX Mentor ALe's Avatar
    Joined
    Aug 2005
    Location
    Milan
    Posts
    383
    Location
    as far as i know you can't assign zero to the calendar control. You can hide it such as:
    [VBA]
    If Me.DTPicker2.Enabled = False Then
    Me.DTPicker2.Visible = False
    Me.Label7.Visible = False
    Me.DTPicker3.Visible = False
    Me.Label8.Visible = False
    End If

    [/VBA]

  9. #9
    VBAX Regular
    Joined
    May 2006
    Posts
    9
    Location
    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.

  10. #10
    VBAX Regular
    Joined
    May 2006
    Posts
    9
    Location
    I have it figured out, I added these lines of code and fixed the problem:


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

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

  11. #11
    Moderator VBAX Wizard lucas's Avatar
    Joined
    Jun 2004
    Location
    Tulsa, Oklahoma
    Posts
    7,323
    Location
    Glad you got it sorted out and thanks for posting your solution..
    Steve
    "Nearly all men can stand adversity, but if you want to test a man's character, give him power."
    -Abraham Lincoln

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •