none
Generar un archivo de Google Earth (KML) RRS feed

  • Pregunta

  • Buen día, acudo a vosotros porque no he encontrado nada en la red; de como cambiar de color a los polígonos según la condición que le puse, pero solo escoge una cuando esta en PROCESO si muestra el polígono de color rojo; pero cuando esta en terminado debe mostrar el color VERDE; pero no muestra el color VERDE sale de color negro, he intentado poner otros colores y también me salen de color negro solo el color ROJO es el que coge. de antemano les agradezco.

    Les pongo el codigo.

    Sub Generar_nodos()

    Set Wb = ActiveWorkbook
    Sheets("Data").Select
    Set LOr = ActiveSheet

    fin_fila = LOr.Cells(Rows.Count, 2).End(xlUp).Row



        Dim temp As String
        Dim latitud As String
        Dim longitud As String
        Dim altitud As String
        'Dim descripcion As String
        Dim nombre As String
        Dim j As Integer
        Dim region, anillo, codigo_tramo, tramo, item, cod_est, prop, tipo_e, material As String
        Dim tipo_tension, nivel_t, altura_e, distancia_e  As String
        Dim seccion As String
        
        ruta = Wb.Path
        
        Open ruta & "\" & "Nodos.kml" For Output As #1
        
        Print #1, "<?xml version='1.0' encoding='UTF-8'?>"
        Print #1, "<kml xmlns='http://www.opengis.net/kml/2.2'>"
        Print #1, "<Document>"
        Print #1, "<name>Nodos.kml</name>"
        
        'Print #1, "    <Style id=" & Chr(34) & "sh_placemark_circle_highlight" & Chr(34) & "> "
        'Print #1, "    </Style>"
        
        Print #1, "    <StyleMap id=" & Chr(34) & " msn_placemark_circle" & Chr(34) & ">"
        Print #1, "        <Pair>"
        Print #1, "           <key>normal</key>"
        Print #1, "           <styleUrl>#sn_placemark_circle</styleUrl>"
        Print #1, "        </Pair>"
        Print #1, "        <Pair>"
        Print #1, "           <key>highlight</key>"
        Print #1, "           <styleUrl>#sh_placemark_circle_highlight</styleUrl>"
        Print #1, "        </Pair>"
        Print #1, "    </StyleMap>"
        
        
        Print #1, "    <Style id=" & Chr(34) & "sn_placemark_circle" & Chr(34) & ">"
        Print #1, "      <IconStyle>"
        Print #1, "        <color>ff0000ff</color>" 'ABGR A=opaco B=Blue G=Green R:Red  #2EFEF7
        Print #1, "        <scale>1.2</scale>"
        Print #1, "            <Icon>"
        Print #1, "                <href>http://maps.google.com/mapfiles/kml/shapes/placemark_circle.png</href>"
        Print #1, "            </Icon>"
        Print #1, "      </IconStyle>"
        Print #1, "    </Style>"

        Print #1, vbclrf
        
      'Nodos
        Print #1, "    <Folder>"
        Print #1, "        <name>Nodos</name>"
        Print #1, "        <open>0</open>"
        
        
        For x = 5 To fin_fila
                        latitud = LOr.Cells(x, 8)
                        'latitud = Replace(latitud, ",", ".")
                        longitud = LOr.Cells(x, 9)
                        'longitud = Replace(longitud, ",", ".")
                        'descripcion = LOr.Cells(j, 52)
                        nombre = LOr.Cells(x, 1) 'Dato a mostrar en archivo KMZ
                        estado = LOr.Cells(x, 10)
                        altitud = 0
                        
                        
                        If estado = "PROCESO" Then
                        Color_ic = "ff0000ff"
                        
                        ElseIf estado = "TERMINADO" Then
                        Color_ic = "ff00ff00"
                        
                        End If
                        
                        Print #1, "    <Placemark>"
                        Print #1, "     <name>" & nombre & "</name>"
                        Print #1, "     <styleUrl>#msn_placemark_circle</styleUrl>"
                        Print #1, "     <Style id=" & Chr(34) & "sh_placemark_circle_highlight" & Chr(34) & ">"
                        Print #1, "         <IconStyle>"
                        Print #1, "         <color>" & Color_ic & "</color>"
                        Print #1, "         <scale>0.8</scale>"
                        Print #1, "         <Icon>"
                        Print #1, "         <href>" & "http://maps.google.com/mapfiles/kml/shapes/placemark_circle_highlight.png" & "</href>"
                        Print #1, "         </Icon>"
                        Print #1, "         </IconStyle>"
                        Print #1, "     </Style>"
                        Print #1, "     <Point>"
                        Print #1, "      <coordinates> " & longitud & ", " & latitud & " ,0</coordinates>"
                        Print #1, "     </Point>"
                        Print #1, "  </Placemark>"
                        
          Next x
                        Print #1, vbclrf
                        
        
        Print #1, "    </Folder>"
        Print #1, "</Document>"
        Print #1, "</kml>"
        
        Close #1



        MsgBox ("Proceso terminado")
          
        
    End Sub

    jueves, 17 de enero de 2019 17:05

Todas las respuestas

  • Hola  Generar un archivo de Google Earth (KML)

    Gracias por levantar tu consulta en los foros de MSDN. Con respecto a la misma, te comento que estaremos realizando una revisión a profundidad acerca del inconveniente que se te está presentando.

    Proporcionaremos una respuesta lo más pronto posible.

    Gracias por usar los foros de MSDN.

    Pedro Alfaro
     ____

    Por favor recuerde "Marcar como respuesta" las respuestas que hayan resuelto su problema, es una forma común de reconocer a aquellos que han ayudado, y hace que sea más fácil para los otros visitantes encontrar la solución más tarde. 

    Microsoft ofrece este servicio de forma gratuita, con la finalidad de ayudar a los usuarios y la ampliación de la base de datos de conocimientos relacionados con los productos y tecnologías de Microsoft.  

    Este contenido es proporcionado "tal cual" y no implica ninguna responsabilidad de parte de Microsoft.
    jueves, 17 de enero de 2019 17:18
    Moderador