在按钮上启动计时器单击 HTA

Question

我有一个计时器，我想在单击按钮后启动它，而不是在启动时使用 now() 变量。我正在从 MSFT 脚本中心提取代码。我相信正确的实现是包装

pbStartTime = Now

围绕一个 if 参数行。但是，我不确定点击按钮背后的逻辑。提前致谢。

   <html>
 <title>Report Generation</title>
 <head>
 <HTA:APPLICATION 
    APPLICATIONNAME="Report Generation"  
    SCROLL="No"
    CAPTION="yes"
    MAXIMIZEBUTTON="no"
    MINIMIZEBUTTON="no"
    SINGLEINSTANCE="yes"
    WINDOWSTATE="normal"
    SYSMENU="no"
    BORDER="thin"
    BORDERSTYLE="Normal"
    CONTEXTMENU="no"
    SELECTION="no">
 </head>

 <style>
 BODY
 {
 background-color: buttonface;
 Font: arial,sans-serif
 margin-top: 10px;
 margin-left: 20px;
 margin-right: 20px;
 margin-bottom: 5px;
 }
 .button
 {
 width: 91px;
 height: 25px;
 font-family: arial,sans-serif;
 font-size: 8pt;
 }
 td
 {
 font-family: arial,sans-serif;
 font-size: 10pt;
 }                     
 #scroll
 {
 height:100%;
 overflow:auto;
 }
 SELECT.FixedWidth 
 {
 width: 17em;  /* maybe use px for pixels or pt for points here */
 }
 </style>

 <script language="vbscript">

    Dim pbTimerID
    Dim pbHTML 
    Dim pbWaitTime
    Dim pbHeight
    Dim pbWidth
    Dim pbBorder
    Dim pbUnloadedColor
    Dim pbLoadedColor
    Dim pbStartTime 

 Dim WinWidth : WinWidth = 350
 Dim WinHeight : WinHeight = 330
 Window.ResizeTo WinWidth, WinHeight

 Sub Sleep(lngDelay)
    CreateObject("WScript.Shell").Run "Timeout /T " & lngDelay & " /nobreak", 0, True
 End Sub

 Sub CheckBoxChange
    If CheckBox(0).Checked Then
    ExecuteScoreCard
    Else
    MsgBox "CheckBox is not checked"
    End If
 End Sub

 Sub ExecuteScoreCard() 

    disablebtns

    Dim sitecode
    Dim objExcel  
    Dim objWorkbook
    Dim objSheet  

    Window_OnLoad

    dim fso: set fso = CreateObject("Scripting.FileSystemObject")
    dim path: path = fso.GetAbsolutePathName(".")

    Set objExcel = CreateObject("Excel.Application")
    objExcel.Automationsecurity = 1
    Set objWorkbook = objExcel.Workbooks.Open(path & "\SCORECARD.xlsm")
    Set objSheet = objWorkbook.Worksheets("Cover Tab") 

    sitecode = document.getElementById("sitecode").value

    objSheet.Cells(4, 2) = sitecode
    objExcel.Run "SCORECARD.xlsm!Module2.RefreshConns"
    Sleep 60 

    objExcel.ActiveWorkbook.SaveAs path & "\Scorecards\" & "Scorecard_" & sitecode & "_" & Year(Now()) & Month(Now()) & Day(Now()) & "_" & Hour(Now()) & Minute(Now()) &".xlsm", 52
    objExcel.ActiveWorkbook.Close
    objExcel.Quit   

    DoAction1

    enablebtns

 End Sub

    Sub Window_OnLoad
        ' Progress Bar Settings
        pbWaitTime = 180        ' How many seconds the progress bar lasts
        pbHeight = 20       ' Progress bar height
        pbWidth= 285        ' Progress bar width
        pbUnloadedColor="white"     ' Color of unloaded area
        pbLoadedColor="black"       ' Color of loaded area
        pbBorder="grey"     ' Color of Progress bar border

        ' Don't edit these things
        pbStartTime = now()
        rProgressbar
        pbTimerID = window.setInterval("rProgressbar", 200)
    end sub

 Sub rProgressbar

    pbHTML = ""
    pbSecsPassed = DateDiff("s",pbStartTime,Now)
    pbMinsToGo =  Int((pbWaitTime - pbSecsPassed) / 60)
    pbSecsToGo = Int((pbWaitTime - pbSecsPassed) - (pbMinsToGo * 60))

    if pbSecsToGo < 10 then
        pbSecsToGo = "0" & pbSecsToGo 
    end if

    pbLoadedWidth = (pbSecsPassed / pbWaittime) * pbWidth
    pbUnloadedWidth = pbWidth - pbLoadedWidth
    pbHTML = pbHTML & "<table border=1 bordercolor=" & pbBorder & " cellpadding=0 cellspacing=0 width=" & pbWidth & "><tr>"
    pbHTML = pbHTML & "<th width=" & pbLoadedWidth & " height=" & pbHeight & "align=left bgcolor="  & pbLoadedColor & "></th>"
    pbHTML = pbHTML & "<th width=" & pbUnloadedWidth & " height=" & pbHeight & "align=left bgcolor="  & pbUnLoadedColor & "></th>"
    pbHTML = pbHTML & "</tr></table><br>"
    pbHTML = pbHTML & "<table border=0 cellpadding=0 cellspacing=0 width=" & pbWidth & "><tr>"
    pbHTML = pbHTML & "<td align=center width=" & pbWidth & "% height=" & pbHeight & ">" & pbMinsToGo & ":" & pbSecsToGo & " remaining</td>"
    pbHTML = pbHTML & "</tr></table>"
    progressbar.InnerHTML = pbHTML

    if DateDiff("s",pbStartTime,Now) >= pbWaitTime then
        StopTimer
    end if

 End Sub

 Sub disablebtns
 btnSubmit.disabled = True
 btnExit.disabled = True
 end Sub

 Sub enablebtns
 btnSubmit.disabled = False
 btnExit.disabled = False
 end Sub

 Sub StopTimer
    window.clearInterval(PBTimerID)
 End Sub

 Sub DoAction1
    MsgBox ("Successfully generated scorecard.")
 End Sub

 Sub DoAction2
    MsgBox ("Successfully generated report2.")
 End Sub

 Sub DoAction3
    MsgBox ("Successfully generated report3.")
 End Sub

 Sub ExitProgram
    window.close()
 End Sub

 </script>

 <body>
 Site Code: <input type="inputbox" name="sitecode" id="sitecode">
 <br><br>
 <input type="checkbox" name="CheckBox"> Scorecard
 <br>
  <input type="checkbox" name="CheckBox"> Report2
 <br>
  <input type="checkbox" name="CheckBox"> Report3
 <br>
 <br>
 <span id = "progressbar"></span>
 <br>
 <div align="center">
  <input type="button" name="accept" id="btnSubmit" value="Submit" onclick="CheckBoxChange" style="height:30px; width:100px">
  <input type="button" name="abort" id="btnExit" value="Exit" onClick="ExitProgram" style="height:30px; width:100px">
  <br>
 </body>
 </html>

Answer 1

您可以添加一个 Start 按钮，就像您的 ABORT 按钮一样。修改你的 Sub Window_OnLoad 重命名为 Sub StartProcess 之类的。然后在您创建的新 Start 按钮中，添加一个 onClick="StartProcess" 属性。

<input type="Button" value="START" name="button2" onClick="StartProcess" class="button">

在按钮上启动计时器单击 HTA

Start timer on button click HTA

vbscript

hta