用户表单中的欧洲日期格式
European Date format in Userform
我有一个用工作表中的日期填充文本框的用户表单。这个想法是能够编辑日期并将它们保存回工作表。问题是日期以美国格式显示，而不是欧洲格式。我知道我需要使用代码强制日期显示为欧洲日期。所以我尝试使用此代码
Dim LValue As String
LValue = Format(Date, "dd/mm/YYYY")
然后我有一个函数来填充表单，我希望在其中显示正确的日期格式
Sub PopulateForm()
Me.Location.Value = rngFound(1, 0).Value
Me.ID.Value = rngFound(1, 1).Value
Me.FirstName.Value = rngFound(1, 2).Value
Me.LastName.Value = rngFound(1, 3).Value
Me.Grade = rngFound(1, 4).Value
Me.ARLFam = rngFound(1, 8).Value
Me.ARLEvac = rngFound(1, 11).Value
Me.HRDFam = rngFound(1, 16).Value
Me.HRDEvac = rngFound(1, 19).Value
Me.CRDFam = rngFound(1, 24).Value
Me.CRDEvac = rngFound(1, 27).Value
Me.RSQFam = rngFound(1, 32).Value
Me.RSQEvac = rngFound(1, 35).Value
Me.COVFam = rngFound(1, 40).Value
Me.COVEvac = rngFound(1, 43).Value
Me.LSQFam = rngFound(1, 48).Value
Me.LSQEvac = rngFound(1, 51).Value
Me.HPCFam = rngFound(1, 56).Value
Me.HPCTrackFam = rngFound(1, 63).Value
Me.HPCEvac = rngFound(1, 59).Value
Me.KNBFam = rngFound(1, 67).Value
Me.KNBEvac = rngFound(1, 70).Value
End Sub
我还没有想出在子例程中放置 LValue 的位置，以便将日期更改为正确的格式。我在正确的轨道上吗？还是我找错树了？
接下来，当我更改日期并将更改保存到工作表时，我遇到了一个新问题。日期进入的单元格被设置为日期，其他单元格有公式处理日期单元格提供的信息。当我保存用户窗体中的日期时，它们显示在正确的单元格中，但是从日期单元格读取的所有其他单元格现在显示 #Value 错误。这是用于将新日期保存到工作表的代码。
Private Sub EnterButton_Click()
Dim LR As Long
Dim replace As Long
Dim response As Long
Dim LValue As String
LValue = Format(Date, "dd/mm/YYYY")
If Me.ID.Value = "" Then
MsgBox "You have not entered an ID."
Me.ID.SetFocus
Exit Sub
End If
FindRecord (Val(Me.ID))
If Not rngFound Is Nothing Then
replace = MsgBox("This record already exists in this Database." & vbNewLine _
& "Replace?", vbYesNo)
If replace = vbYes Then
LR = rngFound.Row
Else
ClearForm
Me.ID.SetFocus
Exit Sub
End If
Else
LR = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
End If
With ws
.Cells(LR, 1).Value = Me.Location
.Cells(LR, 2).Value = Val(Me.ID)
.Cells(LR, 3).Value = Me.FirstName
.Cells(LR, 4).Value = Me.LastName
.Cells(LR, 5).Value = Me.Grade
.Cells(LR, 9).Value = Me.ARLFam
.Cells(LR, 12).Value = Me.ARLEvac
.Cells(LR, 17).Value = Me.HRDFam
.Cells(LR, 20).Value = Me.HRDEvac
.Cells(LR, 25).Value = Me.CRDFam
.Cells(LR, 28).Value = Me.CRDEvac
.Cells(LR, 33).Value = Me.RSQFam
.Cells(LR, 36).Value = Me.RSQEvac
.Cells(LR, 41).Value = Me.COVFam
.Cells(LR, 44).Value = Me.COVEvac
.Cells(LR, 49).Value = Me.LSQFam
.Cells(LR, 52).Value = Me.LSQEvac
.Cells(LR, 57).Value = Me.HPCFam
.Cells(LR, 64).Value = Me.HPCTrackFam
.Cells(LR, 60).Value = Me.HPCEvac
.Cells(LR, 68).Value = Me.KNBFam
.Cells(LR, 71).Value = Me.KNBEvac
End With
If replace = vbYes Then
MsgBox "The existing record on " & ws.Name & " row# " & rngFound.Row & " was overwitten"
Else
MsgBox "The record was written to " & ws.Name & " row# " & LR
End If
response = MsgBox("Do you want to enter another record?", _
vbYesNo)
If response = vbYes Then
ClearForm
Me.ID.SetFocus
Else
Unload Me
End If
End Sub
是否因为日期被保存为文本而不是日期？如果是这样，如何将其保存为欧洲日期？
您当然可以将当前格式更改为欧洲格式，这里是一些如何使用它的示例：
子dates_et_heures()
'Now renvoie la date et l'heure en cours (07.02.2018 09:09:02)
date_test = Now()
'Renvoie : 07.02.18
Range("A1") = Format(date_test, "dd.mm.yy")
'Renvoie : mardi 7 février 2018
Range("A2") = Format(date_test, "dddd d mmmm yyyy")
'Renvoie : Mardi 7 Février 2018
Range("A3") = WorksheetFunction.Proper(Format(date_test, "dddd d mmmm yyyy"))
'Renvoie : mar. 07
Range("A4") = Format(date_test, "ddd dd")
'Renvoie : MAR 07
Range("A5") = "'" & Replace(UCase(Format(date_test, "ddd dd")), ".", "")
'Renvoie : FÉVRIER 2018
Range("A6") = UCase(Format(date_test, "mmmm yyyy"))
'Renvoie : 07.02.2018 09:09
Range("A7") = Format(date_test, "dd.mm.yyyy hh:mm")
'Renvoie : Le 7 février à 9h09'02''
Range("A8") = Format(date_test, "Le d mmmm à h\hmm'ss''")
'Renvoie : 9H09
Range("A9") = Format(date_test, "h\Hmm")
结束子
我没有第二部分的答案，但我希望这也能有所帮助
以下假设您在 Excel 中有真实日期（例如，您可以通过将包含日期的单元格格式化为 General 来证明这一点：它应该显示一个数字）。
Background: dates are stored internally as numbers, the integer part
gives the Date-part, counting the number of days starting from 1.
January 1900. The fraction part is representing the time, 1/3 would be
8am (a third of the day)
VBA 中的文本框始终包含一个字符串。当您想将日期写入文本框并使用 tbStartDate = ActiveSheet.Cells("B2") 和 B2 之类的代码包含日期时，您要求 VBA 将日期转换为字符串。 VBA 会这样做，但它有自己的规则，因此您最终会得到一个看起来像美国日期的字符串。基本上，您应该始终避免 VBA 为您自动转换。相反，为此使用一个函数：Format 它是将日期或数字转换为字符串的正确函数，您已经在前 2 个语句中正确使用了它。要将日期写入文本框，您现在可以写
tbStartDate = Format(ActiveSheet.Cells("B2"), "dd/mm/YYYY")
棘手的部分来了：用户可能会更改日期，而您想将其写回单元格。同样，您不应该让 Excel 隐式地进行转换。问题是，使用普通文本框，您无法阻止用户输入垃圾内容（您可能会阅读 Formatting MM/DD/YYYY dates in textbox in VBA）。
但我们假设您的用户以“正确”的形式输入日期：如何将字符串转换为日期？
您经常会看到使用 CDate 的答案，它根据系统的区域设置将字符串转换为日期。很好，只要所有用户都具有相同的设置。但是，如果您的用户可能有一台从美国或世界任何其他地方新鲜进口的笔记本电脑，您又会遇到同样的问题：VBA 将使用错误的假设转换日期（例如，更改日和月部分）。
因此我通常使用一个小的自定义函数来拆分字符串并将这些部分用作另一个 VBA 函数的参数 DateSerial。如果输入完全是无意义的，它将 return 0 (=1.1.1900)，但不会检查所有无效的可能性。一个 13 作为输入被愉快地接受（DateSerial，顺便说一句，也接受这个）。
Function StrToDate(s As String) As Date
' Assumes input as dd/mm/yyyy or dd.mm.yyyy
Dim dateParts() As String
dateParts = Split(Replace(s, ".", "/"), "/") ' Will work with "." and "/"
If UBound(dateParts) <> 2 Then Exit Function
Dim yyyy As Long, mm As Long, dd As Long
dd = Val(dateParts(0))
mm = Val(dateParts(1))
yyyy = Val(dateParts(2))
If dd = 0 Or mm = 0 Or yyyy = 0 Then Exit Function
StrToDate = DateSerial(yyyy, mm, dd)
End Function
现在，将输入写回单元格可能就像
dim d as Date
d = StrToDate(tbStartdate)
if d > 0 then ActiveSheet.cells(B2) = d
我有一个用工作表中的日期填充文本框的用户表单。这个想法是能够编辑日期并将它们保存回工作表。问题是日期以美国格式显示，而不是欧洲格式。我知道我需要使用代码强制日期显示为欧洲日期。所以我尝试使用此代码
Dim LValue As String
LValue = Format(Date, "dd/mm/YYYY")
然后我有一个函数来填充表单，我希望在其中显示正确的日期格式
Sub PopulateForm()
Me.Location.Value = rngFound(1, 0).Value
Me.ID.Value = rngFound(1, 1).Value
Me.FirstName.Value = rngFound(1, 2).Value
Me.LastName.Value = rngFound(1, 3).Value
Me.Grade = rngFound(1, 4).Value
Me.ARLFam = rngFound(1, 8).Value
Me.ARLEvac = rngFound(1, 11).Value
Me.HRDFam = rngFound(1, 16).Value
Me.HRDEvac = rngFound(1, 19).Value
Me.CRDFam = rngFound(1, 24).Value
Me.CRDEvac = rngFound(1, 27).Value
Me.RSQFam = rngFound(1, 32).Value
Me.RSQEvac = rngFound(1, 35).Value
Me.COVFam = rngFound(1, 40).Value
Me.COVEvac = rngFound(1, 43).Value
Me.LSQFam = rngFound(1, 48).Value
Me.LSQEvac = rngFound(1, 51).Value
Me.HPCFam = rngFound(1, 56).Value
Me.HPCTrackFam = rngFound(1, 63).Value
Me.HPCEvac = rngFound(1, 59).Value
Me.KNBFam = rngFound(1, 67).Value
Me.KNBEvac = rngFound(1, 70).Value
End Sub
我还没有想出在子例程中放置 LValue 的位置，以便将日期更改为正确的格式。我在正确的轨道上吗？还是我找错树了？
接下来，当我更改日期并将更改保存到工作表时，我遇到了一个新问题。日期进入的单元格被设置为日期，其他单元格有公式处理日期单元格提供的信息。当我保存用户窗体中的日期时，它们显示在正确的单元格中，但是从日期单元格读取的所有其他单元格现在显示 #Value 错误。这是用于将新日期保存到工作表的代码。
Private Sub EnterButton_Click()
Dim LR As Long
Dim replace As Long
Dim response As Long
Dim LValue As String
LValue = Format(Date, "dd/mm/YYYY")
If Me.ID.Value = "" Then
MsgBox "You have not entered an ID."
Me.ID.SetFocus
Exit Sub
End If
FindRecord (Val(Me.ID))
If Not rngFound Is Nothing Then
replace = MsgBox("This record already exists in this Database." & vbNewLine _
& "Replace?", vbYesNo)
If replace = vbYes Then
LR = rngFound.Row
Else
ClearForm
Me.ID.SetFocus
Exit Sub
End If
Else
LR = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
End If
With ws
.Cells(LR, 1).Value = Me.Location
.Cells(LR, 2).Value = Val(Me.ID)
.Cells(LR, 3).Value = Me.FirstName
.Cells(LR, 4).Value = Me.LastName
.Cells(LR, 5).Value = Me.Grade
.Cells(LR, 9).Value = Me.ARLFam
.Cells(LR, 12).Value = Me.ARLEvac
.Cells(LR, 17).Value = Me.HRDFam
.Cells(LR, 20).Value = Me.HRDEvac
.Cells(LR, 25).Value = Me.CRDFam
.Cells(LR, 28).Value = Me.CRDEvac
.Cells(LR, 33).Value = Me.RSQFam
.Cells(LR, 36).Value = Me.RSQEvac
.Cells(LR, 41).Value = Me.COVFam
.Cells(LR, 44).Value = Me.COVEvac
.Cells(LR, 49).Value = Me.LSQFam
.Cells(LR, 52).Value = Me.LSQEvac
.Cells(LR, 57).Value = Me.HPCFam
.Cells(LR, 64).Value = Me.HPCTrackFam
.Cells(LR, 60).Value = Me.HPCEvac
.Cells(LR, 68).Value = Me.KNBFam
.Cells(LR, 71).Value = Me.KNBEvac
End With
If replace = vbYes Then
MsgBox "The existing record on " & ws.Name & " row# " & rngFound.Row & " was overwitten"
Else
MsgBox "The record was written to " & ws.Name & " row# " & LR
End If
response = MsgBox("Do you want to enter another record?", _
vbYesNo)
If response = vbYes Then
ClearForm
Me.ID.SetFocus
Else
Unload Me
End If
End Sub
是否因为日期被保存为文本而不是日期？如果是这样，如何将其保存为欧洲日期？
您当然可以将当前格式更改为欧洲格式，这里是一些如何使用它的示例：
子dates_et_heures()
'Now renvoie la date et l'heure en cours (07.02.2018 09:09:02)
date_test = Now()
'Renvoie : 07.02.18
Range("A1") = Format(date_test, "dd.mm.yy")
'Renvoie : mardi 7 février 2018
Range("A2") = Format(date_test, "dddd d mmmm yyyy")
'Renvoie : Mardi 7 Février 2018
Range("A3") = WorksheetFunction.Proper(Format(date_test, "dddd d mmmm yyyy"))
'Renvoie : mar. 07
Range("A4") = Format(date_test, "ddd dd")
'Renvoie : MAR 07
Range("A5") = "'" & Replace(UCase(Format(date_test, "ddd dd")), ".", "")
'Renvoie : FÉVRIER 2018
Range("A6") = UCase(Format(date_test, "mmmm yyyy"))
'Renvoie : 07.02.2018 09:09
Range("A7") = Format(date_test, "dd.mm.yyyy hh:mm")
'Renvoie : Le 7 février à 9h09'02''
Range("A8") = Format(date_test, "Le d mmmm à h\hmm'ss''")
'Renvoie : 9H09
Range("A9") = Format(date_test, "h\Hmm")
结束子
我没有第二部分的答案，但我希望这也能有所帮助
以下假设您在 Excel 中有真实日期（例如，您可以通过将包含日期的单元格格式化为 General 来证明这一点：它应该显示一个数字）。
Background: dates are stored internally as numbers, the integer part gives the
Date-part, counting the number of days starting from 1. January 1900. The fraction part is representing the time, 1/3 would be 8am (a third of the day)
VBA 中的文本框始终包含一个字符串。当您想将日期写入文本框并使用 tbStartDate = ActiveSheet.Cells("B2") 和 B2 之类的代码包含日期时，您要求 VBA 将日期转换为字符串。 VBA 会这样做，但它有自己的规则，因此您最终会得到一个看起来像美国日期的字符串。基本上，您应该始终避免 VBA 为您自动转换。相反，为此使用一个函数：Format 它是将日期或数字转换为字符串的正确函数，您已经在前 2 个语句中正确使用了它。要将日期写入文本框，您现在可以写
tbStartDate = Format(ActiveSheet.Cells("B2"), "dd/mm/YYYY")
棘手的部分来了：用户可能会更改日期，而您想将其写回单元格。同样，您不应该让 Excel 隐式地进行转换。问题是，使用普通文本框，您无法阻止用户输入垃圾内容（您可能会阅读 Formatting MM/DD/YYYY dates in textbox in VBA）。
但我们假设您的用户以“正确”的形式输入日期：如何将字符串转换为日期？
您经常会看到使用 CDate 的答案，它根据系统的区域设置将字符串转换为日期。很好，只要所有用户都具有相同的设置。但是，如果您的用户可能有一台从美国或世界任何其他地方新鲜进口的笔记本电脑，您又会遇到同样的问题：VBA 将使用错误的假设转换日期（例如，更改日和月部分）。
因此我通常使用一个小的自定义函数来拆分字符串并将这些部分用作另一个 VBA 函数的参数 DateSerial。如果输入完全是无意义的，它将 return 0 (=1.1.1900)，但不会检查所有无效的可能性。一个 13 作为输入被愉快地接受（DateSerial，顺便说一句，也接受这个）。
Function StrToDate(s As String) As Date
' Assumes input as dd/mm/yyyy or dd.mm.yyyy
Dim dateParts() As String
dateParts = Split(Replace(s, ".", "/"), "/") ' Will work with "." and "/"
If UBound(dateParts) <> 2 Then Exit Function
Dim yyyy As Long, mm As Long, dd As Long
dd = Val(dateParts(0))
mm = Val(dateParts(1))
yyyy = Val(dateParts(2))
If dd = 0 Or mm = 0 Or yyyy = 0 Then Exit Function
StrToDate = DateSerial(yyyy, mm, dd)
End Function
现在，将输入写回单元格可能就像
dim d as Date
d = StrToDate(tbStartdate)
if d > 0 then ActiveSheet.cells(B2) = d