Board logo

标题: 如何将VBS文件中的VBS代码移植到HTML中?谢谢! [打印本页]

作者: welky    时间: 2009-6-12 08:26     标题: 如何将VBS文件中的VBS代码移植到HTML中?谢谢!

下面的代码主要作用是显示Excel选中区域的合并单元格相对所选区域左上角的偏移量,直接放在VBS文件中结果正确,但要放入HTNL 文档,运行不了,要怎么改动才能正确执行,谢谢!!
  1. Option Explicit
  2. Dim a,ssr,ssc,m,smr, smc, emr, emc
  3. Test
  4. '**********************************************************************************************************************
  5. Sub Test()
  6. Dim oExcel, Rng
  7. MsgBox "111"
  8. Set oExcel = GetObject(, "Excel.Application")
  9. MsgBox "222"
  10. If Err.Number<>0 Then
  11.   Err.Clear
  12.   MsgBox "Error found"
  13.   Set oExcel = CreateObject("Excel.Application")
  14. End If
  15. oExcel.Application.Visible = True
  16. oexcel.Parent.Windows(1).Visible = True
  17. Set Rng = oExcel.ActiveWindow.Selection
  18. MsgBox "The Selection Area is "&Rng.Address(0,0),,"Selection Area"
  19. Dim d, c ', m
  20. Dim sta   'Store the address of the first cell in the selection
  21. 'Dim ssr   'Store the row number of the selection range,row of selection
  22. 'Dim ssc   'Store the column number of the selection range,column of selection
  23. Dim i
  24. 'Dim smr, smc, emr, emc
  25. sta = Rng.Cells(1, 1).Address(0, 0)
  26. ssc = Asc(Left(sta, 1)) - Asc("A") + 1
  27. ssr = CInt(Right(sta, Len(sta) - 1))
  28. Set d = CreateObject("scripting.dictionary")
  29. For Each c In Rng
  30.   If c.MergeCells Then
  31.    If Not d.exists(c.MergeArea.Address(0, 0)) Then
  32.     m = m + 1
  33.     d(c.MergeArea.Address(0, 0)) = ""
  34.    End If
  35.   End If
  36. Next
  37. If m > 0 Then
  38.   'Dim a
  39.   a = d.keys
  40.   'smc = SMColumn(a, ssr, ssc, m)
  41.   smc = SMColumn()
  42.   'smr = SMRow(a, ssr, ssc, m)
  43.   smr = SMRow()
  44.   'emc = EMColumn(a, ssr, ssc, m)
  45.   emc = EMColumn()
  46.   'emr = EMRow(a, ssr, ssc, m)
  47.   emr = EMRow()
  48.   
  49.   For i = 0 To m - 1
  50.    MsgBox "Will be merged cells in the table is: (" & smr(i) & "," & smc(i) & ") " & "(" & emr(i) & "," & emc(i) & ") ",,"Merged Area"
  51.   Next
  52. Else
  53.   MsgBox "没有合并区域"
  54. End If
  55. End Sub         
  56. '**********************************************************************************************************************
  57. 'Function SMColumn(ByVal a, ByVal ssr, ByVal ssc, ByVal m) 'smc
  58. Function SMColumn() 'smc
  59. Dim i
  60. Dim smc()  'Store the start column number of the merge area
  61. ReDim smc(m)
  62. For i = 0 To m - 1
  63.   smc(i) = Asc(Left(a(i), 1)) - Asc("A") - ssc + 2
  64. Next
  65. SMColumn = smc
  66. End Function
  67. '**********************************************************************************************************************
  68. 'Function SMRow(ByVal a, ByVal ssr, ByVal ssc, ByVal m) 'smr
  69. Function SMRow() 'smr
  70. Dim i
  71. Dim smr()  'Store the start row number of the merge area
  72. ReDim smr(m)
  73. For i = 0 To m - 1
  74.   smr(i) = CInt(Mid(a(i), 2, InStr(a(i), ":") - 2)) - ssr + 1
  75. Next
  76. SMRow = smr
  77. End Function
  78. '**********************************************************************************************************************
  79. 'Function EMRow(ByVal a, ByVal ssr, ByVal ssc, ByVal m) 'emr
  80. Function EMRow() 'emr
  81. Dim i
  82. Dim emr()  'Store the start row number of the merge area
  83. ReDim emr(m)
  84. For i = 0 To m - 1
  85.   emr(i) = CInt(Right(a(i), Len(a(i)) - InStr(a(i), ":") - 1)) - ssr + 1
  86. Next  
  87. EMRow = emr
  88. End Function
  89. '**********************************************************************************************************************
  90. 'Function EMColumn(ByVal a, ByVal ssr, ByVal ssc, ByVal m) 'emc
  91. Function EMColumn() 'emc   
  92. Dim i
  93. Dim emc() 'Store the start row number of the merge area
  94. ReDim emc(m)
  95. For i = 0 To m - 1
  96.   emc(i) = Asc(Mid(a(i), InStrRev(a(i), ":") + 1, 1)) - Asc("A") - ssc + 2
  97. Next      
  98. EMColumn = emc
  99. End Function
复制代码

作者: slore    时间: 2009-6-12 14:07

HTML对对象一定有限制的。。。

不然调用run执行程序起来就……
作者: welky    时间: 2009-6-12 21:18

原帖由 slore 于 2009-6-12 14:07 发表
HTML对对象一定有限制的。。。

不然调用run执行程序起来就……

好像是的,不过我不懂具体问题出在哪,
程序运行到这句Set oExcel = GetObject(, "Excel.Application")
好像就不往下运行了,该怎么改呢!?
谢谢!




欢迎光临 批处理之家 (http://bbs.bathome.net/) Powered by Discuz! 7.2