excel vba日期問題

我只是注意到了這一點，我有一個應用程序，用戶傾向於填寫三個日期的信息。開始日期，結束日期和下載截止日期。這些日期框之一的例子列舉如下excel vba日期問題

Private Sub txtEDate_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) 

    'Dim dDate As Date 
    dDate = DateSerial(Year(Date), Month(Date), Day(Date)) 
    txtEDate.Value = Format(txtEDate.Value, "dd/mm/yyyy") 
    dDate = txtEDate.Value = "" 
End Sub

問題香港專業教育學院現在注意到的是，當我摘棗說2012/1/3或2012年5月6日，當我犯這些日期，他們避開改變在我的工作表上分別到2012年3月1日和6/5。如果我的日期輸入是13/6/2012，它將保持不在12個月的範圍內。 Excel工作表與我設定的格式相同。也許它是我提交日期的一個問題。

Private Sub cmdOK_Click() 
Dim checks As Integer 

trim.trimALL 
Call Check_Correct_Data_Entry_Total(checks) 

If checks = 1 Then 
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a Name..." 
    Me.txtName.SetFocus 
End If 

If checks = 2 Then 
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a Number..." 
    Me.txtPhone.SetFocus 
End If 
If checks = 3 Then 
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a ID..." 
    Me.txtID.SetFocus 
End If 
If checks = 4 Then 
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a Department.." 
    Me.txtDepartment.SetFocus 
End If 
If checks = 5 Then 
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a End Date.. " 
    Me.txtEDate.SetFocus 
End If 
If checks = 6 Then 
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a Analysis Dead Date.. " 
    Me.txtDeadDate.SetFocus 
End If 
If checks = 7 Then 
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a Analysis..." 
    Me.cboAnalysis.SetFocus 
End If 
If checks = 8 Then 
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a Application..." 
    Me.cboApplication.SetFocus 
End If 
If checks = 9 Then 
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter amount of Disk Space you will be using..." 
    Me.txtDisks.SetFocus 
End If 

If checks = 10 Then 
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a Cluster..." 
    Me.cboCluster.SetFocus 
End If 
If checks = 11 Then 
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a Core Amount..." 
    Me.cboCores.SetFocus 
End If 

If checks = 0 Then 

    ActiveWorkbook.Sheets("Course Bookings").Activate 

    Dim Row_to_Record_Data As Long 

    Row_to_Record_Data = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1 

    'Generate Unique Key for each new entry (Key = string of userid + numeric timestamp + random 3 letter string) 

    Dim DateNumber As Long 
    Dim RandomString1 As String 
    Dim RandomString2 As String 
    Dim RandomString3 As String 
    Dim RandomString As String 

    Dim Unique_Key As String 

    DateNumber = Date 
    RandomString1 = Chr(Application.WorksheetFunction.RandBetween(65, 90)) 
    RandomString2 = Chr(Application.WorksheetFunction.RandBetween(65, 90)) 
    RandomString3 = Chr(Application.WorksheetFunction.RandBetween(65, 90)) 
    RandomString = RandomString1 & RandomString2 & RandomString3 
    Unique_Key = Format(Hour(Now), "00") & Format(Minute(Now), "00") & Format(Second(Now), "00") & RandomString 

    'Check if overwriting entry selected from frmList ListBox 
    If Overwrite_Row <> 0 Then Row_to_Record_Data = Overwrite_Row 

    Cells(Row_to_Record_Data, 1).Value = txtName.Value 
    Cells(Row_to_Record_Data, 2) = txtPhone.Value 
    Cells(Row_to_Record_Data, 3) = LCase(txtID.Value) 
    Cells(Row_to_Record_Data, 4) = txtDepartment.Value 

    Cells(Row_to_Record_Data, 5) = cboAnalysis.Value 
    Cells(Row_to_Record_Data, 6) = cboApplication.Value 

    'ActiveCell.Offset(0, 7) = cboPriority.Value saved for priority to fill in off administration form 

    Cells(Row_to_Record_Data, 9) = txtSDate.Value 
    Cells(Row_to_Record_Data, 10) = txtDeadDate.Value 
    'ADD ESTIMATED DATE HERE!!!!. 
    Cells(Row_to_Record_Data, 11) = txtEDate.Value 
    Cells(Row_to_Record_Data, 12) = cboCluster.Value 
    Cells(Row_to_Record_Data, 13) = cboCores.Value 
    Cells(Row_to_Record_Data, 14) = txtDisks.Value 
    Cells(Row_to_Record_Data, 16) = txt_sge_number.Value 


    'DVM CHOICES option. 
    If optDefinition = True Then 
     Cells(Row_to_Record_Data, 7).Value = "Definition" 
    ElseIf optValidation = True Then 
     Cells(Row_to_Record_Data, 7).Value = "Validation" 
    Else 
     Cells(Row_to_Record_Data, 7).Value = "Methods" 
    End If 

    'Enter Unique Key if new entry 
    If Overwrite_Row = 0 Then Cells(Row_to_Record_Data, 15).Value = Unique_Key 

End If 

'frmCourseBooking.Error_Messages.Caption = 

    Range("A1").Select 

'clear form to avoid mishaps 
If Overwrite_Row = 0 Then 
    Accecptance_label.Caption = "Adding New Request, Recommend Clear Form After." 
Else 
    Accecptance_label.Caption = "Editted Request, Recommend Clear Form After." 
End If 

If checks = 0 Then 
    Error_Messages.Caption = "" 
End If 

'Reset Overwrite_Row to zero 
Overwrite_Row = 0 


End Sub

這是我將這些日期提交給我的表單的全部功能。特別是它是Cells（Row_to_Record_Data，1）.Value = txtName.Value。我的問題是，如何讓它堅持我在表單中設置的格式，並且一旦提交就不會改變它？

在此先感謝

來源

2012-07-17 Zenaphor

你設置與字符串表？也就是說，你在使用'Cell.Value = dDate'還是'Cell.Value = txtEDate.Value'？使用'Cell.Value = dDate'應該可以避免這個問題。格式「dd/mm/yyyy」是特殊的。如果將單元格的格式設置爲「dd/mm/yyyy」，然後顯示該單元格的NumberFormat，則會顯示「mm/dd/yyyy」。標有星號的日期格式顯示此屬性。我總是使用明確的格式，例如「dd mmm yyyy」。有關更多信息，請參閱我的問題http://stackoverflow.com/q/9839676/973283。 – 2012-07-17 17:33:59

來命名它在第一個代碼段後面的每個單元格中的輸入。但如果我把cell.value = dDate它會給我今天的日期，因爲dDate被設置爲Date。我將如何調整第一個代碼塊，它的txtEdate部分保持它的英國格式，我打算？我讀了你的帖子，只是試圖抓住它現在 – Zenaphor 2012-07-18 06:40:15

正確的把它放到「dd mmm yyyy」格式，然後告訴我的工作表在短期內顯示它，現在它似乎正確顯示，感謝回覆 – Zenaphor 2012-07-18 07:12:54

Private Sub txtEDate_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)  
'Dim dDate As Date  
dDate = DateSerial(Year(Date), Month(Date), Day(Date))  
txtEDate.Value = Format(txtEDate.Value, "dd mmm yyyy")  
dDate = txtEDate.Value = "" 
End Sub

答案從輸入修改從@Tony Dallimore

來源

2012-07-18 07:14:12 Zenaphor

excel vba日期問題

回答

相關問題