标题: 如何将VBS文件中的VBS代码移植到HTML中?谢谢! [打印本页]
作者: welky 时间: 2009-6-12 08:26 标题: 如何将VBS文件中的VBS代码移植到HTML中?谢谢!
下面的代码主要作用是显示Excel选中区域的合并单元格相对所选区域左上角的偏移量,直接放在VBS文件中结果正确,但要放入HTNL 文档,运行不了,要怎么改动才能正确执行,谢谢!!
- Option Explicit
- Dim a,ssr,ssc,m,smr, smc, emr, emc
- Test
- '**********************************************************************************************************************
- Sub Test()
-
- Dim oExcel, Rng
- MsgBox "111"
- Set oExcel = GetObject(, "Excel.Application")
- MsgBox "222"
- If Err.Number<>0 Then
- Err.Clear
- MsgBox "Error found"
- Set oExcel = CreateObject("Excel.Application")
- End If
- oExcel.Application.Visible = True
- oexcel.Parent.Windows(1).Visible = True
- Set Rng = oExcel.ActiveWindow.Selection
- MsgBox "The Selection Area is "&Rng.Address(0,0),,"Selection Area"
- Dim d, c ', m
- Dim sta 'Store the address of the first cell in the selection
- 'Dim ssr 'Store the row number of the selection range,row of selection
- 'Dim ssc 'Store the column number of the selection range,column of selection
- Dim i
- 'Dim smr, smc, emr, emc
-
- sta = Rng.Cells(1, 1).Address(0, 0)
- ssc = Asc(Left(sta, 1)) - Asc("A") + 1
- ssr = CInt(Right(sta, Len(sta) - 1))
-
- Set d = CreateObject("scripting.dictionary")
-
- For Each c In Rng
- If c.MergeCells Then
- If Not d.exists(c.MergeArea.Address(0, 0)) Then
- m = m + 1
- d(c.MergeArea.Address(0, 0)) = ""
- End If
- End If
- Next
-
- If m > 0 Then
- 'Dim a
- a = d.keys
- 'smc = SMColumn(a, ssr, ssc, m)
- smc = SMColumn()
- 'smr = SMRow(a, ssr, ssc, m)
- smr = SMRow()
- 'emc = EMColumn(a, ssr, ssc, m)
- emc = EMColumn()
- 'emr = EMRow(a, ssr, ssc, m)
- emr = EMRow()
-
- For i = 0 To m - 1
- MsgBox "Will be merged cells in the table is: (" & smr(i) & "," & smc(i) & ") " & "(" & emr(i) & "," & emc(i) & ") ",,"Merged Area"
- Next
- Else
- MsgBox "没有合并区域"
- End If
- End Sub
- '**********************************************************************************************************************
- 'Function SMColumn(ByVal a, ByVal ssr, ByVal ssc, ByVal m) 'smc
- Function SMColumn() 'smc
- Dim i
- Dim smc() 'Store the start column number of the merge area
-
- ReDim smc(m)
- For i = 0 To m - 1
- smc(i) = Asc(Left(a(i), 1)) - Asc("A") - ssc + 2
- Next
- SMColumn = smc
-
- End Function
- '**********************************************************************************************************************
- 'Function SMRow(ByVal a, ByVal ssr, ByVal ssc, ByVal m) 'smr
- Function SMRow() 'smr
- Dim i
- Dim smr() 'Store the start row number of the merge area
-
- ReDim smr(m)
- For i = 0 To m - 1
- smr(i) = CInt(Mid(a(i), 2, InStr(a(i), ":") - 2)) - ssr + 1
- Next
- SMRow = smr
-
- End Function
- '**********************************************************************************************************************
- 'Function EMRow(ByVal a, ByVal ssr, ByVal ssc, ByVal m) 'emr
- Function EMRow() 'emr
- Dim i
- Dim emr() 'Store the start row number of the merge area
-
- ReDim emr(m)
- For i = 0 To m - 1
- emr(i) = CInt(Right(a(i), Len(a(i)) - InStr(a(i), ":") - 1)) - ssr + 1
- Next
- EMRow = emr
-
- End Function
- '**********************************************************************************************************************
- 'Function EMColumn(ByVal a, ByVal ssr, ByVal ssc, ByVal m) 'emc
- Function EMColumn() 'emc
- Dim i
- Dim emc() 'Store the start row number of the merge area
-
- ReDim emc(m)
- For i = 0 To m - 1
- emc(i) = Asc(Mid(a(i), InStrRev(a(i), ":") + 1, 1)) - Asc("A") - ssc + 2
- Next
- EMColumn = emc
-
- 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://bathome.net./) |
Powered by Discuz! 7.2 |