Question

一旦用户提交表单，我就会运行一些潜艇。但是，一旦vbs启动代码的一部分，在后面启动excel并运行一个宏，计时器就会挂起。想知道我如何改进我的代码来解决这个/如果可能的话。提前谢谢。

 <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">
 'Option Explicit

    Dim pbTimerID
    Dim pbHTML 
    Dim pbWaitTime
    Dim pbHeight
    Dim pbWidth
    Dim pbBorder
    Dim pbUnloadedColor
    Dim pbLoadedColor
    Dim pbStartTime 
    Dim sitecode
    Dim objExcel  
    Dim objWorkbook
    Dim objSheet  

    'window size
    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 sleepy
    Set objShell = CreateObject("WScript.Shell")
    strCmd = "%COMSPEC% /c"
    objShell.Run strCmd,0,1
End Sub 

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

 Sub ExecuteScoreCard() 
    sleepy
    disablebtns
    sleepy  
    ProgressBarViz
    sleepy
    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 ProgressBarViz
    ' 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
    sleepy
    pbStartTime = now()
    sleepy
    rProgressbar
    sleepy
    pbTimerID = window.setInterval("rProgressbar", 200)
    sleepy
 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

    sleepy

    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

因此，如果有人遇到这个问题，可以解决这个问题的方法是分离实际调用excel表的sub并触发宏，只需调用vbs和excel工作簿。

即。

Sub ExecuteScoreCard() 
   sleepy
   disablebtns
   sleepy  
   ProgressBarViz
   sleepy

   Set wsh = CreateObject("WScript.Shell")
   set fso = CreateObject("Scripting.FileSystemObject")
   wsh.Run fso.GetAbsolutePathName(".") & "\refresh.vbs " & """" & document.getElementById("sitecode").value & """", 7, False
   set fso = Nothing
   set wsh = Nothing

   Sleep 10

   DoAction1

   enablebtns

End Sub

Refresh.vbs

If WScript.Arguments.Count > 0 Then
    sitecode = Wscript.Arguments(0)
Else
    WScript.Quit
End If

set fso = CreateObject("Scripting.FileSystemObject")
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") 

objSheet.Cells(4, 2) = sitecode

objExcel.Run "Scorecard.xlsm!Module2.RefreshConns"

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

这不是我的答案，而是另一位专家交流的用户。虽然工作得很好。

VBS计时器未通过HTA更新/刷新

1 个答案: