Question

我需要在Word文档中将时间四舍五入到最近的四分之一小时。我不太擅长编码。

经过一番搜索之后，我发现了一些vba代码，但是它并不起作用。代码是：

Sub Time()
Dim num() As String
Dim tod() As String
Dim temp As String

num = Split(Time, ":")
tod = Split(num(2), " ")

If Val(num(1)) < 15 Then
    temp = "00"
ElseIf Val(num(1)) < 30 Then
    temp = "15"
ElseIf Val(num(1)) < 45 Then
    temp = "30"
ElseIf Val(num(1)) < 60 Then
    temp = "45"
End If
gettime = num(0) + ":" + temp + ":00 " + tod(1)

End Function
End Sub

当我尝试运行它时，我收到一条消息：

“编译错误：预期的函数或变量”

代码第五行中的“时间”突出显示，我认为这是程序停止运行的地方。

对此我将不胜感激。

谢谢

史蒂夫你好，表格中的其余代码如下：

此模块不会影响时间取整问题，但我将其纳入其中以免遗漏任何内容。

Option Explicit

Sub ClusterCheck()

Dim i As Integer, k As Integer, iCluster As Integer, bResult As Boolean
Dim sFieldNameNo As String, sName As String

    On Error Resume Next    ' If the first formfield is a checkbox, this will bypass the error that Word returns

    sName = Selection.FormFields(1).Name    ' Get the name of the formfield
    bResult = ActiveDocument.FormFields(sName).CheckBox.Value    ' Get the result of the current formfield
    sFieldNameNo = Number(sName)    ' Get generic number
    sName = Left(sName, Len(sName) - Len(sFieldNameNo))    ' Get generic name

    ' Determine how many fields are within the cluster group
    iCluster = 1
    Do Until ActiveDocument.Bookmarks.Exists(sName & iCluster) = False
        iCluster = iCluster + 1
    Loop
    iCluster = iCluster - 1

    ' If the check field is true, turn all of the other check fields to false
    Application.ScreenUpdating = False
    If bResult = True Then
        For k = 1 To iCluster
            If k <> sFieldNameNo Then ActiveDocument.FormFields(sName & k).Result = False
        Next
    End If
    Application.ScreenUpdating = True

End Sub

这是“数字”模块：

Option Explicit

Function Number(ByVal sNumber As String) As String

' This module finds the form fields number within the field name

    ' Loops through the field name until it only has the number
    Do Until IsNumeric(sNumber) = True Or sNumber = ""
        sNumber = Right(sNumber, Len(sNumber) - 1)
    Loop

    Number = sNumber

End Function

这是保护模块：

Option Explicit

Sub Protect()

    ActiveDocument.Protect Password:="wup13", NoReset:=True, Type:=wdAllowOnlyFormFields
End Sub

Sub Unprotect()

    ActiveDocument.Unprotect Password:="wup13"
End Sub

这是在打开和关闭文档时激活的代码：

Option Explicit

Sub Document_Open()

    ' Zooms to page width, turns on Hidden Text, and turns off ShowAll and Table Gridlines
    With ActiveWindow.View
        .Zoom.PageFit = wdPageFitBestFit
        .ShowHiddenText = True
        .TableGridlines = False
        .ShowAll = False
    End With

    Options.UpdateFieldsAtPrint = False

End Sub

Sub Document_Close()

    ' Turn on ShowAll and Table Gridlines
    With ActiveWindow.View
        .ShowAll = True
        .TableGridlines = True
    End With

    Options.UpdateFieldsAtPrint = True

End Sub

这就是表格中的所有代码。我不太擅长VBA，但希望可以（在一些帮助下）解决此问题。

附加税表的详细信息

人员详细信息姓：
名字：

等级：
编号：
位置：

成本中心代码：

工作时间在指定的公共/演出假期中，有几天要执行额外的职责吗？是0否0 如果是，请输入假期日期/详细信息：

开始时间：[文本表单字段]
日期：

时间已停止：[文本表单字段]
日期：

总加班人数：

您是轮班工人吗？是0否0

执行额外职责的详细信息：

车辆详细信息车：是0否0 摩托车：是0否0 注册编号：
机队编号：

固定车辆时间：
是0否0（仅用于固定工作）

车辆里程表开始：
里程表表面处理：
总公里数：

客户的详细信息公司/组织名称：
电话号码：

联系人姓名：

职位编号：

特殊服务付款是否预先收到付款？是0否0

如果是–金额：
收据编号：
日期：

如果否-金额：
发票编号：
日期：

I，证明以上信息为真

（签名）（日期）
经理认证（通过名册检查和认证正确）

（签名）（日期）

Answer 1

vbforums中的代码按建议使用时会给我一个下标超出范围的错误。

在VBA IDE中，您可以通过将光标置于关键字上并按F1来获得关键字功能的说明。这将打开该特定关键字的MS帮助页面。

在OP代码中，主要过程是“时间”。这将导致VBA出现问题，因为它与Time关键字相同，因此我们可以有效地说

time(time)

并且VBA将以错误停止，因为第二次使用时间将被解释为子时间，而不是VBA时间函数，因此您将收到错误消息“参数不可选项”。

下面的代码将提供OP的要求。

Option Explicit

Sub test_gettime()
Dim myTime                  As String

    myTime = Now()
    Debug.Print myTime
    Debug.Print Format(myTime, "hh:mm:ss")
    Debug.Print gettime(Format(myTime, "hh:mm:ss"))

    ' without the format statement we should also get the date

    myTime = Now()
    Debug.Print
    Debug.Print myTime
    Debug.Print gettime(myTime)

End Sub

Public Function gettime(this_time As String) As String
Dim myTimeArray()                       As String
Dim myQuarterHour                       As String

    myTimeArray = Split(this_time, ":")

    ' Note that myTimeArray has not been converted to numbers
    ' Comparison of strings works by comparing the ascii values of each character
    ' in turn until the requested logic is satisfied
    Select Case myTimeArray(1)
        Case Is < "15"
            myQuarterHour = "00"
        Case Is < "30"
            myQuarterHour = "15"
         Case Is < "45"
             myQuarterHour = "30"
         Case Is < "60"
             myQuarterHour = "45"
         Case Else
            Debug.Print "More than 60 minutes in the hour??"
    End Select
    gettime = myTimeArray(0) + ":" + myQuarterHour + ":00 "
End Function

如何将时间四舍五入到最近的四分之一小时

1 个答案: