通过HTA触发宏的VBS(无法运行宏)

时间:2016-05-24 19:53:43

标签: vba excel-vba vbscript macros hta

我有一个HTA脚本,它最终触发代码的vbs部分来调用VBA宏但由于某种原因我收到了这个错误:

enter image description here

我已经确保启用了对VBA的Trust访问,因此我觉得我的代码中的某些内容与HTA不兼容。这是代码:提前感谢您的时间。

<html>
 <title>Report Generation</title>
<head>
<HTA:APPLICATION 
 APPLICATIONNAME="Report Generation"
 ID="objHTA"  
 SCROLL="yes"
 SINGLEINSTANCE="yes"
 WINDOWSTATE="normal">
</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 WinWidth : WinWidth = 350
Dim WinHeight : WinHeight = 250
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() 
  Dim sitecode
  Dim objExcel  
  Dim objWorkbook
  Dim objSheet

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

  Set objExcel = CreateObject("Excel.Application")
  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 "RefreshConns"
  Sleep 75 

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

  MsgBox("Successfully generated scorecard.")

End Sub 

 Sub ExitProgram
  window.close()
 End Sub

</script>

<body>
  Site Code: <input type="inputbox" name="sitecode" id="sitecode">
<br>
  <input type="checkbox" name="CheckBox"> Scorecard
<br>
  <input type="checkbox" name="CheckBox"> Report2
<br>
  <input type="checkbox" name="CheckBox"> Report3
<br>
<br>
  <input type="submit" name="accept" value="Submit" onclick="CheckBoxChange">
  <input type="button" value="Exit" onClick="ExitProgram">
</body>
</html> 

1 个答案:

答案 0 :(得分:1)

objWorkbook.RunAutoMacros(1)

在objExcel.Run“RefreshConns”行之前的HTA代码中包含上面的代码行。

相关问题