Only one Macro.
Entire content
When I click on the macro button Explorer Save As opens to C:\Users\Paul\Desktop with an Excel icon and Save *.kml in the top of the window.
When I save the file in a different name "Hidden" A2 gets overwritten with the new name. After saving MsgBox opens with "File successfully exported, Open in Google Earth?"
[ATTACH=JSON]{"data-align":"none","data-size":"full","title":"Save .kml.png","data-attachmentid":1224525}[/ATTACH]
Sub ExportKML()
Dim sFilename As Variant, docname As String, Quote As String
Dim FileHandle As Integer
sFilename = Application.GetSaveAsFilename(Quote & ".kml", "Google Earth files (*.kml),*.kml", 1, "Save *.kml")
If sFilename = False Then
Exit Sub
Else
Sheets("Hidden").Range("A2") = sFilename
End If
Set filepath = Sheets("Hidden").Range("A2")
' Set document name
docname = "Charter Quote"
FileHandle = FreeFile()
Open sFilename For Output As #FileHandle
' Your Syntax
Print #FileHandle, "</Document>" & Chr(13) & Chr(10) & "</kml>"
Close #FileHandle
Open filepath For Output As #1
'Get Data and its attributes
'Loop through each data point in column A, get attributes if any and write it out to kml
For j = 2 To yA
With Sheets("Main")
If .Cells(j1) = 0 Or .Cells(j2) = 0 Then GoTo CellNext
End With
Latitude = Sheets("Main").Cells(j, 2)
Longitude = Sheets("Main").Cells(j, 3)
ptName = Sheets("Main").Cells(j, 1)
Print #1, [Hidden!A6] & ptName & [Hidden!A7]
'read no of attributes (max 10 supported)
ncols = Sheets("Main").Cells(j, 15).End(xlToLeft).Column
CellNext:
Next
Print #1, [Hidden!A4] & docname & [Hidden!A5]
Print #1, [Hidden!A8]
Print #1, [Hidden!A9]
Print #1, [Hidden!A10]
Print #1, [Hidden!A6]
Print #1, [Main!A2]
Print #1, [Hidden!A7]
Print #1, [Hidden!A11]
Print #1, [Main!D2]
Print #1, [Hidden!A12]
Print #1, [Hidden!A8]
Print #1, [Hidden!A9]
Print #1, [Hidden!A10]
Print #1, [Hidden!A6]
Print #1, [Main!A3]
Print #1, [Hidden!A7]
Print #1, [Hidden!A11]
Print #1, [Main!D3]
Print #1, [Hidden!A12]
Print #1, [Hidden!A8]
Print #1, [Hidden!A9]
Print #1, [Hidden!A10]
Print #1, [Hidden!A6]
Print #1, [Main!A4]
Print #1, [Hidden!A7]
Print #1, [Hidden!A11]
Print #1, [Main!D4]
Print #1, [Hidden!A12]
Print #1, [Hidden!A8]
Print #1, [Hidden!A9]
Print #1, [Hidden!A10]
Print #1, [Hidden!A6]
Print #1, [Main!A5]
Print #1, [Hidden!A7]
Print #1, [Hidden!A11]
Print #1, [Main!D5]
Print #1, [Hidden!A12]
Print #1, [Hidden!A8]
Print #1, [Hidden!A9]
Print #1, [Hidden!A10]
Print #1, [Hidden!A6]
Print #1, [Main!A6]
Print #1, [Hidden!A7]
Print #1, [Hidden!A11]
Print #1, [Main!D6]
Print #1, [Hidden!A12]
Print #1, [Hidden!A8]
Print #1, [Hidden!A9]
Print #1, [Hidden!A10]
Print #1, [Hidden!A6]
Print #1, [Main!A7]
Print #1, [Hidden!A7]
Print #1, [Hidden!A11]
Print #1, [Main!D7]
Print #1, [Hidden!A12]
Print #1, [Hidden!A8]
Print #1, [Hidden!A9]
Print #1, [Hidden!A10]
Print #1, [Hidden!A6]
Print #1, [Main!A8]
Print #1, [Hidden!A7]
Print #1, [Hidden!A11]
Print #1, [Main!D8]
Print #1, [Hidden!A12]
Print #1, [Hidden!A8]
Print #1, [Hidden!A9]
Print #1, [Hidden!A10]
Print #1, [Hidden!A6]
Print #1, [Main!A9]
Print #1, [Hidden!A7]
Print #1, [Hidden!A11]
Print #1, [Main!D9]
Print #1, [Hidden!A12]
Print #1, [Hidden!A8]
Print #1, [Hidden!A9]
Print #1, [Hidden!A10]
Print #1, [Hidden!A6]
Print #1, [Main!A10]
Print #1, [Hidden!A7]
Print #1, [Hidden!A11]
Print #1, [Main!D10]
Print #1, [Hidden!A12]
Print #1, [Hidden!A8]
Print #1, [Hidden!A9]
Print #1, [Hidden!A10]
Print #1, [Hidden!A6]
Print #1, [Main!A11]
Print #1, [Hidden!A7]
Print #1, [Hidden!A11]
Print #1, [Main!D11]
Print #1, [Hidden!A12]
Print #1, [Hidden!A8]
Print #1, [Hidden!A9]
Print #1, [Hidden!A10]
Print #1, [Hidden!A6]
Print #1, [Main!A12]
Print #1, [Hidden!A7]
Print #1, [Hidden!A11]
Print #1, [Main!D12]
Print #1, [Hidden!A12]
Print #1, [Hidden!A8]
Print #1, [Hidden!A9]
Print #1, [Hidden!A10]
Print #1, [Hidden!A6]
Print #1, [Main!A13]
Print #1, [Hidden!A7]
Print #1, [Hidden!A11]
Print #1, [Main!D13]
Print #1, [Hidden!A12]
Print #1, [Hidden!A8]
Print #1, [Hidden!A9]
Print #1, [Hidden!A10]
Print #1, [Hidden!A6]
Print #1, [Main!A14]
Print #1, [Hidden!A7]
Print #1, [Hidden!A11]
Print #1, [Main!D14]
Print #1, [Hidden!A12]
Print #1, [Hidden!A14]
Print #1, [Main!D2]
Print #1, [Main!D3]
Print #1, [Main!D4]
Print #1, [Main!D5]
Print #1, [Main!D6]
Print #1, [Main!D7]
Print #1, [Main!D8]
Print #1, [Main!D9]
Print #1, [Main!D10]
Print #1, [Main!D11]
Print #1, [Main!D12]
Print #1, [Main!D13]
Print #1, [Main!D14]
Print #1, [Hidden!A15]
Print #1, [Hidden!A13]
Close #1
Dim openinGE As String, GE_exe_Loc As String, GE_exe As String
openinGE = MsgBox("File successfully exported, Open in Google Earth?", vbYesNo + vbInformation, "Open")
If openinGE = vbYes Then
GE_exe_Loc = Sheets("Hidden").Range("A1").Value
If GE_exe_Loc = "" Then
GE_exe = MsgBox("Could not locate Google Earth executable, Locate manually?", vbOKCancel + vbCritical, "Google Earth exe")
If GE_exe = vbCancel Then
Exit Sub
Else
GE_exe_Loc = Application.GetSaveAsFilename("googleearth", "googleearth (*.exe),*.exe", 1, "Save *.exe")
If GE_exe_Loc = False Then
Exit Sub
Else
Sheets("Hidden").Range("A1").Value = GE_exe_Loc
End If
End If
End If
sFilename = Sheets("Hidden").Range("A2").Value
If Not Dir(GE_exe_Loc, vbDirectory) = vbNullString Then
Shell Chr(34) & GE_exe_Loc & Chr(34) & " " & Chr(34) & sFilename & Chr(34), vbMaximizedFocus
Else
MsgBox "Google Earth does not exist"
End If
Exit Sub
ElseIf openinGE = vbNo Then
sFilename = Sheets("Hidden").Range("A2").Value
If Not Dir(GE_exe_Loc, vbDirectory) = vbNullString Then
Shell Chr(34) & GE_exe_Loc & Chr(34) & " " & Chr(34) & sFilename & Chr(34), vbMaximizedFocus
Else
MsgBox "Google Earth does not exist"
End If
Exit Sub
ElseIf openinGE = vbNo Then
Exit Sub
End If
End Sub
Sub AddImageCombo()
Sheets("Hidden").Visible = True
End Sub
Display More