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
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