Placemarks galore

We are now ready to generate the KML for a Placemark. First it is assumed that the current sheet i.e. the one open when the VBA program was started, is the one containing the data. If this is not the case you need to extend the program to allow the user to specify the data sheet. It is also assumed that the data starts in row 2 with column headings in row 1.

Dim Row As Integer
Row = 2

Again, if this is not the case you need to give the user some way to modify the default.

Now we get to the part of the code that does the real work. We use a Do loop to extract the data from each row, process it and then move on to the next row. The loop ends when the Longitude column contains a blank The test could be on any column - its just a matter of detecting when there is no more data to process.

Do Until (Cells(Row, LongCol) = "")
 Call MakePlaceMark(
      Cells(Row, LongCol), 
      Cells(Row, LatCol), 
      Cells(Row, MagCol))
 Row = Row + 1
Loop

The work of generating the KML for the Placemark is done by the MakePlaceMark subroutine which we have yet to write. Notice the way that the Cells function is used to get the data sorted in the cell at a specified row and column. That is:

Cells(row,col)

retrieves the value in the cell at the intersection of row and col where column A is col=1 column B is col=2 and so on.

After generating all of the KML for one Placemark for each row of data all that remains is to write the customary closing KML tags:

Call outputLine("</Document>")
Call outputLine("</kml>")
End Sub

The complete subroutine is:

Private Sub CommandButton1_Click()
Dim LatCol As Integer
LatCol = Asc(TextBox1.Text)-Asc("A")+1
Dim LongCol As Integer
LongCol = Asc(TextBox2.Text)- Asc("A")+1
Dim MagCol As Integer
MagCol = Asc(TextBox4.Text)-Asc("A")+1

Call outputLine("<xml version='1.0' 
                  encoding='UTF-8'>")
Call outputLine("<kml xmlns=
  'http://earth.google.com/kml/2.2'>")
Call outputLine("<Document>")

Dim Row As Integer
Row = 2
Do Until (Cells(Row, LongCol) = "")
 Call MakePlaceMark(
    Cells(Row, LongCol), 
    Cells(Row, LatCol), 
    Cells(Row, MagCol))
 Row = Row + 1
Loop
Call outputLine("</Document>")
Call outputLine("</kml>")
End Sub

Making a Pacemark - using an icon

Now we have to write a subroutine that generates the KML for a Placemark. This is fairly easy but there is a tricky part in generating the graphics for a custom shape.

The subroutine starts:

Private Sub MakePlaceMark(
             lon As Double,
             lat As Double, 
             mag As Double)

lat and lon are parameters which specify the position of the Placemark and in this case mag is a parameter that controls the size of the symbol drawn. Notice that you can't use "long" as the name of the longitude parameter because long is a reserved word i.e. it means something special to VBA.

Now we simply write the standard KML for a Placemark:

 Call outputLine("<Placemark>")
 Call outputLine("<Point> <coordinates>")
 Call outputLine(lon & "," & lat)
 Call outputLine("</coordinates> </Point>")
 Call outputLine("</Placemark>")

End Sub

The position parameters are output to set the Placemark's position. If you use this version of the MakePlaceMark subroutine then a standard Placemark icon is used. This might be what you want in which case the program is finished.

The complete MakePlaceMark sutroutine is:

Private Sub MakePlaceMark(
            lon As Double,
            lat As Double, 
            mag As Double)

 Call outputLine("<Placemark>")
 Call outputLine("<Point> <coordinates>")
 Call outputLine(lon & "," & lat)
 Call outputLine("</coordinates> </Point>")
 Call outputLine("</Placemark>")

End Sub

Here, however, we want to scale the symbol used for the placemark and to do this we will draw the outline of a polygon. To do this we first need another subroutine to generate the points that define it.

<ASIN:0470515112>

<ASIN:0470236825>

<ASIN:1430218290>

<ASIN:0321525590>