根据表格中的经纬度批量完成封闭图形的编制并保存成谷歌地球识别的kml文件

标题代码要求

在空白的表格中，A列为形成一个封闭图形的经纬度合集，每个经度纬度之间都是通过逗号隔开的，B列为计划生成封闭图形的名称，A列和B列没有标题行，计划通过VBA代码，批量生成封闭图形，并保存成谷歌地球可以识别的kml文件，结果保存在D:\polygons.kml中

标题表格填写要求

标题可实现的代码

Option Explicit

Sub GenerateKMLFile()
’ Initialize the KML document
Dim kml As String
kml = “<?xml version=""1.0"" encoding=""UTF-8""?>” & vbCrLf & _
“<kml xmlns=”“http://www.opengis.net/kml/2.2"”>" & vbCrLf & _
“” & vbCrLf & _
“Polygons” & vbCrLf & _
“” & vbCrLf

' Loop through all non-empty cells in column A
Dim lastRow As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row

Dim cell As Range
For Each cell In Range("A1:A" & lastRow)
    If Not IsEmpty(cell.Value) Then
        ' Split the coordinates into an array
        Dim arrCoords() As String
        arrCoords = Split(cell.Value, ",")

        ' Get the name of the polygon from column B
        Dim name As String
        name = Trim(cell.Offset(0, 1).Value)

        ' Create the KML for the polygon
        Dim polygonKML As String
        polygonKML = "<Placemark>" & vbCrLf & _
                     "<name>" & name & "</name>" & vbCrLf & _
                     "<Polygon>" & vbCrLf & _
                     "<outerBoundaryIs>" & vbCrLf & _
                     "<LinearRing>" & vbCrLf & _
                     "<coordinates>"

        ' Add the coordinates to the polygon KML string
        Dim i As Long
        For i = 0 To UBound(arrCoords) Step 2
            If i + 1 <= UBound(arrCoords) Then
                polygonKML = polygonKML & arrCoords(i + 1) & "," & arrCoords(i) & ",0" & vbCrLf
            End If
        Next i

        ' Close the polygon KML string
        polygonKML = polygonKML & "</coordinates>" & vbCrLf & _
                     "</LinearRing>" & vbCrLf & _
                     "</outerBoundaryIs>" & vbCrLf & _
                     "</Polygon>" & vbCrLf & _
                     "</Placemark>" & vbCrLf

        ' Add the polygon KML to the main KML document
        kml = kml & polygonKML
    End If
Next cell

' Close the KML document
kml = kml & "</Folder>" & vbCrLf & _
      "</Document>" & vbCrLf & _
      "</kml>"

' Save the KML file to disk
Dim filePath As String
filePath = "D:\polygons.kml"

Dim fileNum As Integer
fileNum = FreeFile()
Open filePath For Output As #fileNum
Print #fileNum, kml
Close #fileNum

End Sub