Option Explicit 'Потребовать явного объявления всех переменных в файле
Public myRibbon As IRibbonUI Public myText As Date Public gCount As Date
Sub timer() gCount = Now + TimeValue("00:00:01") Application.OnTime gCount, "getLabel_label1" End Sub 'customUI (элемент: customUI, атрибут: onLoad), 2010+ Private Sub onLoadRibbon(ribbon As IRibbonUI) 'Объявите глобальную переменную объекта ленты: Set myRibbon = ribbon End Sub
'editBox1 (элемент: editBox, атрибут: onChange), 2010+ Private Sub onChange_editBox(control As IRibbonControl, text As String) On Error GoTo instr myText = text On Error GoTo 0 myRibbon.Invalidate instr: If Err.Number = 13 Then MsgBox "Вы ввели не дату!" & Chr(10) & "Пожалуйста введите дату призыва!", vbExclamation, "Ошибка" End Sub
Sub getLabel_label1(control As IRibbonControl, ByRef label) Dim res As Date Dim days As Integer If myText = 0 Then Exit Sub days = Date - myText res = Date - myText - TimeSerial(0, 0, 1) If myText = Date Then label = "С ДМБ!!!" Else If myText > Date Then MsgBox "Введите дату ПРИЗЫВА!", vbExclamation, "Ошибка" label = "Err" Else If (365 - res) < 0 Then MsgBox "Скорее всего, Вы не срочник!", vbExclamation, "Ошибка" label = "Err" Else label = (365 - days) & " " & Format((365 - res), "hh:mm:ss") End If: End If End If Call timer End Sub
[/vba]
Код в vba
[vba]
Код
Option Explicit 'Потребовать явного объявления всех переменных в файле
Public myRibbon As IRibbonUI Public myText As Date Public gCount As Date
Sub timer() gCount = Now + TimeValue("00:00:01") Application.OnTime gCount, "getLabel_label1" End Sub 'customUI (элемент: customUI, атрибут: onLoad), 2010+ Private Sub onLoadRibbon(ribbon As IRibbonUI) 'Объявите глобальную переменную объекта ленты: Set myRibbon = ribbon End Sub
'editBox1 (элемент: editBox, атрибут: onChange), 2010+ Private Sub onChange_editBox(control As IRibbonControl, text As String) On Error GoTo instr myText = text On Error GoTo 0 myRibbon.Invalidate instr: If Err.Number = 13 Then MsgBox "Вы ввели не дату!" & Chr(10) & "Пожалуйста введите дату призыва!", vbExclamation, "Ошибка" End Sub
Sub getLabel_label1(control As IRibbonControl, ByRef label) Dim res As Date Dim days As Integer If myText = 0 Then Exit Sub days = Date - myText res = Date - myText - TimeSerial(0, 0, 1) If myText = Date Then label = "С ДМБ!!!" Else If myText > Date Then MsgBox "Введите дату ПРИЗЫВА!", vbExclamation, "Ошибка" label = "Err" Else If (365 - res) < 0 Then MsgBox "Скорее всего, Вы не срочник!", vbExclamation, "Ошибка" label = "Err" Else label = (365 - days) & " " & Format((365 - res), "hh:mm:ss") End If: End If End If Call timer End Sub
п.5s: Запрещается: 5s - не предоставлять ссылки на другие ресурсы в том случае, если тема была создана Вами не только на форуме сайта "Мир MS Excel"msi2102