通信人家园
标题: EXCEL里直接生成KML文件 [查看完整版帖子] [打印本页]
时间: 2017-4-5 11:26
作者: whbtomboy
标题: EXCEL里直接生成KML文件
Sub GenPlacemark()
Dim i As Integer
Dim s As String '存储生成的代码
Dim f As String '保存的文件名
Dim rng As Range
f = "c:\point.kml"
s = "<kml xmlns=""http://earth.google.com/kml/2.0"">" & Chr(13) & _
"<Folder>"
Set rng = Intersect(Selection, ActiveSheet.UsedRange)
If rng Is Nothing Then MsgBox "请选择合适的数据信息!": Exit Sub
For i = 1 To Selection.Rows.Count
s = s & "<Placemark><description></description><name>" & rng(i, 1).Value & _
" </name><LookAt>" & _
"<longitude>" & rng(i, 2).Value & "</longitude>" & _
"<latitude>" & rng(i, 3).Value & "</latitude>" & _
"<range>2000</range>" & _
"<tilt>0</tilt>" & _
"<heading>3</heading>" & _
"</LookAt><Point>" & _
"<coordinates>" & rng(i, 2).Value & "," & rng(i, 3) & ",0</coordinates>" & _
"</Point> </Placemark>" & Chr(13)
Next
s = s & Chr(13) & "</Folder></kml>"
SaveFile s, f ' 件，则中文名可以正常显示
FileZM f, "GB2312", f, "UTF-8" '转换成UTF-8编码的文件
MsgBox "已生成！"
End Sub
Sub SaveFile(sql As String, fileName As String)
Dim fso, MyFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile = fso.CreateTextFile(fileName, True)
MyFile.writeline (sql)
MyFile.Close
Set fso = Nothing
Set MyFile = Nothing
End Sub
'vba生成的文件是gb2312编码的,如果站点是汉字，则google不能识别，显示乱码，需要转换成UTF-8的编码，下面的函数是把已生成的GB2312文件转成UTF-8文件
'参数：源文件，源文件编码，目标文件，目标文件编码。编码举例----"gb2312"、"UTF-8"等
Sub FileZM(sFile As String, sCode As String, dFile As String, dCode As String)
Dim ObjStream As Object
Set ObjStream = CreateObject("Adodb.Stream")
With ObjStream
.Mode = 3 'adModeReadWrite = 3 ' 指示读/写权限。
.Type = 1 'adTypeBinary = 1
.Open
.LoadFromFile sFile '源文件
.Position = 0
.Type = 2 'adTypeText = 2
.Charset = sCode
sCode = .ReadText '读取文本到sCode
.Position = 0 ' 这只是定位到文件头，保留
.SetEOS ' 完全重写不要漏了这个,通过使当前 Position 成为流的结尾来更新 EOS 属性的值。当前位置后面的所有字节或字符都将被截断
.Type = 2 'adTypeText = 2
.Charset = dCode '指定输出编码
.WriteText sCode '写入指定的文本数据到Adodb.Stream
.SaveToFile dFile, 2
.Close
End With
Set ObjStream = Nothing
End Sub
上面的程序的实现都是参考以下资料完成的，这里面设计的知识还是挺多的，涉及到kml文档，文本的写入，编码的转换等，也是费了一番功夫才得以实现，完成之后还是感觉自己欠缺的还是很多，需要学的东西很多，还得继续奋进，把自己工作中经验分享给大家，希望能帮助大家！
资料参考：
时间: 2017-10-19 15:27
作者: 注册真的好烦
弱弱的问一句，这个怎么用？
| 通信人家园 (https://www.txrjy.com/) |
Powered by C114 |