0

我有一个用户窗体，它使用工作表中的日期填充文本框。这个想法是能够编辑日期并将它们保存回工作表。问题是日期以美国格式显示，而不是欧洲格式。我知道我需要使用代码来强制日期显示为欧洲。所以我尝试使用此代码

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

是因为日期已保存为文本而不是日期吗？如果是这样，我如何将其保存为欧洲日期？

4

2 回答 2

0

您当然可以将当前的格式更改为欧洲格式，以下是一些如何使用它的示例：

子日期_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")

结束子

我没有第二部分的答案，但我希望这也能有所帮助

于 2020-10-27T13:17:55.220 回答
0

以下假设您在 Excel 中有真实日期（例如，您可以通过将包含日期的单元格格式化为General：它应该显示一个数字来证明这一点）。

背景：日期在内部存储为数字，整数部分给出- 部分Date，从 1900 年 1 月 1 日开始计算天数。小数部分表示时间，1/3 将是上午 8 点（一天的三分之一）

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。如果输入完全是胡说八道，它将返回 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
于 2020-10-27T16:25:31.777 回答