PDA

View Full Version : xml add column range B:C5000



sanju2323
08-14-2015, 01:40 AM
i am plot a line to google earth, in this excel sheet vba code done the job, but in this code difficulty added only single row, i need add coordinate Column range "B3:C" last ex. 74.57770083,20.32727139,0
74.57328611,20.34023833,0
74.56824389,20.35208722,0
74.56848694,20.35315833,0
how to do that or please give me fresh code


Sub Poly_KML()

Dim ThisAddress As String
ChDir ThisWorkbook.Path
ThisAddress = Application.GetSaveAsFilename(FileFilter:="KML Files (*.kml),*.kml", Title:="Save Location & Name")

filePath = ThisAddress
docName = "PLANEMAN.KML"
FolderName = "Folder"

Open filePath For Output As #1

outputText = "<?xml version=""1.0"" encoding=""UTF-8""?> <kml xmlns=""http://www.opengis.net/kml/2.2"" xmlns:gx=""http://www.google.com/kml/ext/2.2"" xmlns:kml=""http://www.opengis.net/kml/2.2"" xmlns:atom=""http://www.w3.org/2005/Atom""> <Document><name>" & docName & "</name> <Folder> <name>" & FolderName & "</name> <open>1</open>"
Print #1, outputText

For Each cell In [Data!B3]

If cell.Value = "" Then
Exit For
End If

StrPart1 = "<Style id=""sn_ylw-pushpin""><IconStyle><color>" & "ff0000ff" & "</color></IconStyle><LineStyle><width>" & "2" & "</width><color>" & "ffffff55" & "</color></LineStyle><PolyStyle><color>" & "ffffff55" & "</color></PolyStyle></Style>"
StrPart2 = "<Placemark><name>" & "Route" & "</name> <styleUrl>#sn_ylw-pushpin</styleUrl> <LineString> "


'Need Coordinate Column B3:C5000

StrPart3 = "<coordinates>" & cell(1, 1) & "," & cell(1, 2) & ",0 </coordinates> </LineString></Placemark>"


outputText = StrPart1 & StrPart2 & StrPart3
Print #1, outputText

Next

outputText = "</Folder></Document></kml>"
Print #1, outputText

Close #1

MsgBox "Macro Complete"

'
End Sub

sanju2323
08-15-2015, 08:04 AM
Is that possable or not please any one answer here.