首创EXCEL表另存为冻结首行的htm文件

百度不到去谷歌

前几天人问了个问题，就是他需要另存excel为htm文件 这样没装excel的也可以打开
另外因为行数很多 所以想让htm文件也具有和excle一样的首行冻结的功能
因为以前学过一点htm  百度了一下htm冻结首行的原理 功夫不负有心人  花了一整晚的时间
采取了移花接木的方法 将excel另存的文件 添加修改了部分htm代码 使之具备了冻结首行的功能
应该还可以做到冻结首列 只是略嫌麻烦
另外这个只能用于IE浏览器 其他内核的浏览器可能会无法正常冻结首行 待以后再完善了
代码中 很多都是以前写好的通用函数  实际只有主过程是另外写的
希望需要的人可以用得到

1. Option Explicit
   
2. Sub 发布HTM文件(target As Range)
   
3. '发布锁定表头的HTM文件
   
4.     Dim fname$, i&, s$, myHtml$
   
5.     fname = ActiveWorkbook.Path & "" & target.Worksheet.name & ".htm"
   
6.     Call saveAsHtml(fname, target.Worksheet.name, target.Address) '待转换区域另存htm
   
7.     myHtml = getFileText(fname) '读取htm字符串
   
8.     For i = 1 To 3 '写入css元素 替换原表头及div标签
   
9.         myHtml = Replace(myHtml, [参数].Cells(i, 2), [参数].Cells(i, 1))
   
10.     Next
    
11.     i = InStr(myHtml, "</tr>") '第一个tr结束位置即表头位置
    
12.     s = Mid(myHtml, i + 1) '取出表头后面的数据暂存
    
13.     myHtml = Replace(Left(myHtml, i), "<td", "<th") '取出表头前面的用以替换tr为th
    
14.     myHtml = myHtml & s '合并网页字符串
    
15.     writeToFile fname, myHtml '写入转换后Html文件
    
16. End Sub
    
17. Sub saveAsHtml(ByVal fname$, shtname$, rngAddress$)
    
18. 'sheet中的rngAddress另存在htm文件fname
    
19.     With ActiveWorkbook.PublishObjects.Add(xlSourceSheet, _
    
20.         fname, shtname, rngAddress, xlHtmlStatic, _
    
21.         "工作簿1_18861", "")
    
22.         .Publish (True)
    
23.         .AutoRepublish = False
    
24.     End With
    
25. End Sub
    
26. Sub writeToFile(ByVal filename$, ByVal text$)
    
27. '将字符串写入文件中
    
28.     Dim sFile As Object, Fso As Object
    
29.     Set Fso = CreateObject("Scripting.FileSystemObject")
    
30.     Set sFile = Fso.CreateTextFile(filename$, True)
    
31.     sFile.Write (text)
    
32.     sFile.Close
    
33.     Set sFile = Nothing
    
34.     Set Fso = Nothing
    
35. End Sub
    
36. Function getFileText(ByVal filename$) As String
    
37. '读取文件所有字符串
    
38.     Const ForReading = 1, ForWriting = 2, ForAppending = 3
    
39.     Dim fs, f 'fs文件对象，f为TextStream对象
    
40.     Set fs = CreateObject("Scripting.FileSystemObject")
    
41.     Set f = fs.OpenTextFile(filename$, ForReading, 0) '打开文件为TextStream对象
    
42.     getFileText = f.readall
    
43.     f.Close
    
44.     Set f = Nothing: Set fs = Nothing
    
45. End Function
    
46. Public Sub test()
    
47.     发布HTM文件 Sheet1.Range("A:M")
    
48. End Sub
    
49. Public Sub 全部发布() '导出活动工作簿中所有sheet为htm
    
50.     Dim sh As Worksheet
    
51.     For Each sh In ActiveWorkbook.Sheets
    
52.         发布HTM文件 sh.UsedRange
    
53.     Next
    
54. End Sub
    
55. 
    
56. Public Sub 发布当前表() '导出活动工作表sheet为htm
    
57.     发布HTM文件 ActiveSheet.UsedRange
    
58. End Sub
    

复制代码

1EXCEL另存为首行冻结HTM文件.rar (25.77 KB, 下载次数: 134)

2014-5-12 20:11 上传

点击文件名下载附件

鄂龙蒙

精品！精品！！收藏了，谢谢楼主分享。

yf_home

不错，关注一下。

VBA万岁

收藏并关注，谢谢分享！

willimwang

学习了，谢谢楼主分享！

li2t

又见高人面

sunny_8848

收藏学习，谢谢楼主分享！

aoe1981

神奇的领域，做个记号，寻找合适的时机……

琼恩·雪诺

好东西，果断占位学习

bailanhong

谢谢，好东西！！