Как округлить время до ближайшего четверти часа в слове

Question

Мне нужно округлить время до ближайшего четверти часа в текстовом документе. Я не очень хорош в кодировании.

После долгих поисков я нашел некоторый код 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, но надеюсь, что смогу решить эту проблему (с небольшой помощью).

ДЕТАЛИ ДОПОЛНИТЕЛЬНОЙ ФОРМЫ

Персоны Фамилия:
Имя (я):

Уровень:
No.:
Расположение:

Код МВЗ:

Время отработано Были ли какие-либо дни выполнения дополнительной обязанности в назначенный праздничный или праздничный день? Да 0 нет 0 Если да, введите дату / данные праздника:

Время началось: [Текстовое поле]
Дата:

Время прекращено: [Текстовое поле]
Дата:

Всего заявленных сверхурочных:

Вы рабочий смены? Да 0 Нет 0

Подробности выполненной дополнительной пошлины:

Информация об автомобиле Автомобиль: Да 0 Нет 0 Мотоцикл: Да 0 Нет 0 Регистрационный № :
Флот №:

Стационарное транспортное средство, часы:
Да 0 Нет 0 (используется только для стационарных работ)

Запуск одометра автомобиля:
Отделка одометра:
Всего км:

Данные клиента Название компании / организации:
Телефон:

Контактное лицо:

№ работы:

Оплата за специальные услуги Оплата была получена заранее? Да 0 Нет 0

Если да - сумма:
Квитанция № ::1085* Дата:

Если нет - сумма:
Счет №: Дата:

Я, подтверждаю, что приведенная выше информация соответствует действительности

(Подпись) (Дата)
Сертификация менеджера (проверено реестром и подтверждено правильно)

(Подпись) (Дата)

Answer 1

Код из vbforums дает мне индекс ошибки вне диапазона при использовании в соответствии с рекомендациями.

В интегрированной среде разработки VBA вы можете получить объяснения того, что делают ключевые слова, поместив курсор на ключевое слово и нажав клавишу 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