Vincular Excel y Google Earts Con Visual Basic
Estimados he trabajado y moldeado un código el cual me exporta de muy buena manera los datos de excel a google earts pero el único problema es que en mi código hace referencia a la latitud y longitud y los datos que tengo son Norte, Sur y Zona y no se como ustedes hacen para saber como se llama o que nombre tiene el cuadro de texto de google earts ya que aun soy novato en ese tema y necesito saber como se llama ese cuadro para poder cambiar la parte de latitud y longitud por Norte, Sur y Zona que son los datos que tengo.
Aquí en esta imagen tengo como ver los datos doy en propiedades para ver los mismos.
Aquí en esta imagen ven La latitud y longitud los cuales ya tengo identificado como se llama la celda para poder ponerlo en el código el cual esta colocado pero no requiero eso ahora.
Aquí en doy en Herramienta/Opciones... y selecciono solo la opción Universal Transversal del Mercator y listo acepto.
Aquí en tengo los cuadros de texto de los cuales deseo saber como se llaman en código para poder insertarlo en mi cogido el cual anexo lineas abajo.
Aquí la forma de mi Excel el cual se extrae con la macro que tengo.
Aquí mi código me genera de manera excelente un archivo .kml en escritorio el cual al abrirlo me muestra el punto en google earts se puede cambiar a .txt y asi veo mi cogido que genere para verificar.
Anexo mi código en comentario debido a que no me permite insertarlo por espacio.
Alli en la parte puse un comentaro donde ver como cambiar esa parte para poder generar mi cogido.
2 Respuestas
Sub Crear_kml()
Dim encabezado1 As String
Dim encabezado2 As String
Dim placemark As String
Dim nombre As String
Dim abrir As String
Dim LookAt1 As String
Dim LookAt2 As String
Dim coordenadas() As Variant
Dim puntos() As Variant
Dim description() As Variant
encabezado1 = "<?xml version=""1.0"" encoding=""UTF-8""?>"
encabezado2 = "<kml xmlns=""http://www.opengis.net/kml/2.2"">"
nombre = "<name>"
On Error Resume Next
Sheets("Codigo").Activate
If Err.Number <> 0 Then
Sheets.Add before:=Sheets(1)
ActiveSheet.Name = "Codigo"
Sheets("Codigo").Activate
Err.Clear
On Error GoTo 0
Else
On Error GoTo 0
ActiveSheet.Name = "Codigo"
ActiveSheet.Cells.Select
Selection.ClearContents
End If
Sheets("coordenadas").Activate
ult = Cells(Rows.Count, 1).End(xlUp).Row 'Obtiene la cantidad de celdas que tienen información
ReDim coordenadas(ult, 2)
ReDim puntos(ult)
ReDim description(ult)
For i = 1 To ult
For j = 1 To 2
coordenadas(i, j) = Cells(i + 1, j + 1)
Next j
puntos(i) = Cells(i + 1, 1)
description(i) = Cells(i + 1, 5)
Next i
Sheets("Codigo").Activate
ActiveSheet.Cells(1, 1) = encabezado1
ActiveSheet.Cells(2, 1) = encabezado2
ActiveSheet.Cells(3, 1) = "<Document>"
ActiveSheet.Cells(4, 1) = vbTab & "<Folder>"
ActiveSheet.Cells(5, 2) = vbTab & "<name>PUNTOS</name>"
ActiveSheet.Cells(6, 2) = vbTab & "<open>1</open>"
ActiveSheet.Cells(7, 2) = vbTab & "<LookAt>"
ActiveSheet.Cells(8, 3) = vbTab & "<longitude>" & coordenadas(1, 2) & "</longitude>" ' Aqui debe estar el Norte
ActiveSheet.Cells(9, 3) = vbTab & "<latitude>" & coordenadas(1, 1) & "</latitude>" ' Aqui debe estar el Sur
'ActiveSheet.Cells(10, 3) = vbTab & "<latitude>" & coordenadas(1, 3) & "</latitude>" ' Aqui debe estar la ZONA aun no se como arreglar esta fila
ActiveSheet.Cells(11, 2) = vbTab & "</LookAt>"
For i = 1 To ult - 1
j = 7 * (i - 1)
ActiveSheet.Cells(j + 12, 2) = vbTab & "<Placemark>"
ActiveSheet.Cells(j + 13, 3) = vbTab & "<name>" & puntos(i) & "</name>"
ActiveSheet.Cells(j + 14, 3) = vbTab & "<description>" & description(i) & "</description>"
ActiveSheet.Cells(j + 15, 3) = vbTab & "<Point>"
ActiveSheet.Cells(j + 16, 4) = vbTab & " <coordinates>" & coordenadas(i, 2) & "," & coordenadas(i, 1) & ",0</coordinates>" ' Aqui anida todo norte,este,zona.
ActiveSheet.Cells(j + 17, 3) = vbTab & "</Point>"
ActiveSheet.Cells(j + 18, 2) = vbTab & "</Placemark>"
Next i
ActiveSheet.Cells(j + 19, 1) = vbTab & "</Folder>"
ActiveSheet.Cells(j + 20, 1) = "</Document>"
ActiveSheet.Cells(j + 21, 1) = "</kml>"
Call EXPORTAR_TXT_CARACTERES
End Sub
Sub EXPORTAR_TXT_CARACTERES()
Dim i As Double
'Creamos automáticamente un .txt en blanco que llamamos EJEMPLO
'el archivo se creará en la misma unidad que tenemos el Excel.
Archivo_txt = "C:\Users\LENOVO\Desktop\Prueba2.kml" 'Prueba2.txt" para el codigo
'si queremos cambiar su ubicación basta con poner Archivo_txt = "E:\EJEMPLO.txt"
Open Archivo_txt For Output As #1
With ActiveWorkbook.Sheets(1)
fin = .Cells(Rows.Count, 1).End(xlUp).Row
'realizamos bucle para pasar los datos al txt
For i = 1 To fin
'ejemplo de txt delimitado por caracteres Tab
Print #1, .Cells(i, 1) & vbTab & .Cells(i, 2) & vbTab & .Cells(i, 3) & vbTab & .Cells(i, 4) '.Range(i & ":" & i)
Next i
Close
End With
Sheets(1).Delete
End SubAquí el código
Si esto te aporta, hay una vinculación a google maps
https://www.youtube.com/playlist?list=PLdK9H5dMIfQh4zqG3p3mkgx5-la11Vrgd Fijate como se crea un vinculo a google maps
https://macrosenexcel.com/hyperlink-o-hipervinculo-google-maps