Keskustelu: Ohjelmointikysymykset: VB.NET, VB6, VBA: vb6 ja excelin ohjaus

Private Sub Command1_Click()
   Dim xlApp As Excel.Application
   Dim wb As Workbook
   Dim ws As Worksheet
   Dim var As Variant
var = "Toimiiko?"

   Set xlApp = New Excel.Application

   Set wb = xlApp.Workbooks.Open("C:\Program Files\APV\apvprogramm.xlsm")

   Set ws = wb.Worksheets("Data") 'Specify your worksheet name
   ws.Range("B2").Value = var

   'or
  ' var = ws.Cells(1, 1).Value
   wb.Close

   xlApp.Quit

   Set ws = Nothing
   Set wb = Nothing
   Set xlApp = Nothing



End Sub

Private Sub Command1_Click()
   Dim xlApp As excel.Application
   Dim Wb As Workbook
   Dim Ws As Worksheet
   Dim var As Variant
var = "Toimiiko se?"

   Set xlApp = New excel.Application

   Set Wb = xlApp.Workbooks.Open("C:\Program Files\APV\APVprogramm.xlsm")
xlApp.DisplayAlerts = False
   Set Ws = Wb.Worksheets("Data") 'Specify your worksheet name
   Ws.Range("B4").Value = var




  On Error Resume Next
Wb.Close True

   xlApp.Quit

   Set Ws = Nothing
   Set Wb = Nothing
   Set xlApp = Nothing



End Sub

' modFolder.bas
Option Explicit

Public Enum FolderEnum
	feCDBurnArea = 59              ' \Docs & Settings\User\Local Settings\Application Data\Microsoft\CD Burning
	feCommonAppData = 35           ' \Docs & Settings\All Users\Application Data
	feCommonAdminTools = 47        ' \Docs & Settings\All Users\Start Menu\Programs\Administrative Tools
	feCommonDesktop = 25           ' \Docs & Settings\All Users\Desktop
	feCommonDocs = 46              ' \Docs & Settings\All Users\Documents
	feCommonPics = 54              ' \Docs & Settings\All Users\Documents\Pictures
	feCommonMusic = 53             ' \Docs & Settings\All Users\Documents\Music
	feCommonStartMenu = 22         ' \Docs & Settings\All Users\Start Menu
	feCommonStartMenuPrograms = 23 ' \Docs & Settings\All Users\Start Menu\Programs
	feCommonTemplates = 45         ' \Docs & Settings\All Users\Templates
	feCommonVideos = 55            ' \Docs & Settings\All Users\Documents\My Videos
	feLocalAppData = 28            ' \Docs & Settings\User\Local Settings\Application Data
	feLocalCDBurning = 59          ' \Docs & Settings\User\Local Settings\Application Data\Microsoft\CD Burning
	feLocalHistory = 34            ' \Docs & Settings\User\Local Settings\History
	feLocalTempInternetFiles = 32  ' \Docs & Settings\User\Local Settings\Temporary Internet Files
	feProgramFiles = 38            ' \Program Files
	feProgramFilesCommon = 43      ' \Program Files\Common Files
	'feRecycleBin = 10              ' ???
	feUser = 40                    ' \Docs & Settings\User
	feUserAdminTools = 48          ' \Docs & Settings\User\Start Menu\Programs\Administrative Tools
	feUserAppData = 26             ' \Docs & Settings\User\Application Data
	feUserCache = 32               ' \Docs & Settings\User\Local Settings\Temporary Internet Files
	feUserCookies = 33             ' \Docs & Settings\User\Cookies
	feUserDesktop = 16             ' \Docs & Settings\User\Desktop
	feUserDocs = 5                 ' \Docs & Settings\User\My Documents
	feUserFavorites = 6            ' \Docs & Settings\User\Favorites
	feUserMusic = 13               ' \Docs & Settings\User\My Documents\My Music
	feUserNetHood = 19             ' \Docs & Settings\User\NetHood
	feUserPics = 39                ' \Docs & Settings\User\My Documents\My Pictures
	feUserPrintHood = 27           ' \Docs & Settings\User\PrintHood
	feUserRecent = 8               ' \Docs & Settings\User\Recent
	feUserSendTo = 9               ' \Docs & Settings\User\SendTo
	feUserStartMenu = 11           ' \Docs & Settings\User\Start Menu
	feUserStartMenuPrograms = 2    ' \Docs & Settings\User\Start Menu\Programs
	feUserStartup = 7              ' \Docs & Settings\User\Start Menu\Programs\Startup
	feUserTemplates = 21           ' \Docs & Settings\User\Templates
	feUserVideos = 14              ' \Docs & Settings\User\My Documents\My Videos
	feWindows = 36                 ' \Windows
	feWindowFonts = 20             ' \Windows\Fonts
	feWindowsResources = 56        ' \Windows\Resources
	feWindowsSystem = 37           ' \Windows\System32
End Enum

Private Declare Function SHGetFolderPathW Lib "shfolder" (ByVal hwndOwner As Long, ByVal nFolder As Long, ByVal hToken As Long, ByVal dwFlags As Long, ByVal pszPath As Long) As Long

Public Function SpecialFolder(pfe As FolderEnum) As String
	Const MAX_PATH = 260
	Static bytBuffer(0 To MAX_PATH + 1)
	Dim strBuffer As String

	strBuffer = bytBuffer
	If SHGetFolderPathW(0, pfe, 0, 0, StrPtr(strBuffer)) = 0 Then SpecialFolder = Left$(strBuffer, InStr(strBuffer, vbNullChar) - 1)
	If Right$(SpecialFolder, 1) = "\" Then SpecialFolder = Left$(SpecialFolder, Len(SpecialFolder) - 1)
End Function

Lomake (Form1)
'BorderStyle 1 - FixedSingle
' StartUpPosition 2 - CenterScreen

Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim row As Integer
Dim col As Integer
Dim ColLetter() As String


'Ohjausobjektit:
'1 MSFlexGrid (MSFlexGrid1)
'asetukset:
'Rows 2, Cols 2
'Fixed Rows 1, Fixed Cols 1
'ScrollBars 3 - Both
'FocusRect 2 - Heavy
'HighLight 1 -Always
'MousePointer 0 - Default
'FillStyle 0 - Single
'SelectionMode 0 - Free
'AllowUserResizing 3 - Both

'1 komentopainike (Command1)
'1 Label (Label1)

Private Sub Form_Load()

    Dim i As Integer

    If Dir("C:\xlsamples\xlsample1.xls") = "" Then

        Dim cat As adox.Catalog
        Dim tbl As adox.Table
        Dim col As adox.Column
        Set cat = New adox.Catalog
        Dim colNames() As String

        colNames = Split(",ID,Pvm,Data", ",") 'esim.

        'Excel 2000 - 2003 tiedostot
        'cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        '"Data Source=C:\xlsamples\xlsample1.xls;Extended Properties=Excel 8.0"

        'Excel 2007 - 2010 tiedostot
        cat.ActiveConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=C:\xlsamples\xlsample1.xls;Extended Properties=Excel 12.0"

        For i = 1 To 3
            Set tbl = New adox.Table
            tbl.Name = "Taul" & CStr(i)

            For j = 1 To 3
                Set col = New adox.Column
                With col
                    .Name = colNames(j)
                    .Type = adVarWChar

                End With
                tbl.Columns.Append col
                Set col = Nothing
            Next j

            cat.Tables.Append tbl
            Set tbl = Nothing

        Next i

        Set cat = Nothing
        Erase collNames

    End If

    Dim sql As String
    Dim connstr As String
    connstr = _
    "Provider=Microsoft.ACE.OLEDB.12.0;" + _
    "Data Source=C:\xlsamples\xlsample1.xls;" + _
    "Extended Properties=""Excel 12.0 Xml;HDR=No"""
    sql = "SELECT * FROM [Taul1$];"
    Set conn = New ADODB.Connection
    conn.Mode = adModeShareExclusive
    conn.ConnectionString = connstr
    conn.Open

    Set rs = New ADODB.Recordset
    rs.Open sql, conn, adOpenDynamic, adLockOptimistic, 1

    MSFlexGrid1.Cols = rs.Fields.Count + 1

    Dim rw As Integer: rw = 1

    MSFlexGrid1.ColWidth(0) = 500

    ReDim ColLetter(25) As String

    For i = 65 To 90
        ColLetter(i - 65) = Chr(i)
    Next i

    MSFlexGrid1.ColAlignment(0) = flexAlignCenterCenter

    For i = 1 To MSFlexGrid1.Cols - 1
        MSFlexGrid1.TextMatrix(0, i) = ColLetter(i - 1)
        MSFlexGrid1.FixedAlignment(i) = flexAlignCenterCenter
    Next i

    rs.MoveFirst

    Do While Not rs.EOF

        rw = rw + 1
        MSFlexGrid1.Rows = rw
        On Error Resume Next
        MSFlexGrid1.TextMatrix(rw - 1, 0) = rw - 1

        For i = 1 To MSFlexGrid1.Cols
            MSFlexGrid1.TextMatrix(rw - 1, i) = rs.Fields(i - 1).Value
        Next i

        rs.MoveNext

    Loop

    Command1.Caption = "Lisää uusi rivi"
    MSFlexGrid1.row = 0

End Sub

Private Sub Form_Unload(Cancel As Integer)

    rs.Close
    conn.Close
    Set rs = Nothing
    Set conn = Nothing

End Sub

Private Sub MSFlexGrid1_Click()

    If row = 0 Or col = 0 Then
        Exit Sub
    End If

    Static tagValue As String
    tagValue = MSFlexGrid1.TextMatrix(row, col)

    Dialog.Caption = "Muuta solun (" & ColLetter(col - 1) & CStr(row) & ") arvoa"
    Dialog.Text1.Text = tagValue
    Dialog.Show 1

    If dialogresult <> "__CANCEL" And dialogresult <> tagValue Then

        MSFlexGrid1.TextMatrix(row, col) = dialogresult
        rs.MoveFirst

        For i = 0 To row - 2
            rs.MoveNext
        Next i

        rs.Fields(col - 1).Value = dialogresult
        rs.Update

    End If

End Sub

Private Sub MSFlexGrid1_EnterCell()

    row = MSFlexGrid1.row
    col = MSFlexGrid1.col

End Sub

Private Sub Command1_Click()

    Dim i As Integer

    rs.AddNew
    For i = 0 To rs.Fields.Count - 1
        rs.Fields(i) = ""
    Next
    rs.Update
    rs.MoveFirst


    Dim rw As Integer: rw = 1

    Do While Not rs.EOF

        rw = rw + 1
        MSFlexGrid1.Rows = rw
        On Error Resume Next
        MSFlexGrid1.TextMatrix(rw - 1, 0) = rw - 1

        For i = 1 To MSFlexGrid1.Cols
            MSFlexGrid1.TextMatrix(rw - 1, i) = rs.Fields(i - 1).Value
        Next i

        rs.MoveNext

    Loop

    Label1.Caption = "Klikaa hiirellä solua jonka arvoa haluat muuttaa"


End Sub

Private Sub MSFlexGrid1_LostFocus()
    Label1.Caption = ""
End Sub

'Lomake (Dialog)
'BorderStyle 3 - FixedDialog
'ClipControls False
'ControlBox False
'StartUpPositon 2 - CenterScreen

'Ohjausobjektit:
'1 tekstiruutu (Text1)
'2 komentopainiketta (OKButton & CancelButton)

Option Explicit

Private Sub Form_Load()
    Text1.Text = ""
End Sub

Private Sub CancelButton_Click()
    dialogresult = "__CANCEL"
    Unload Me
End Sub

Private Sub OKButton_Click()
    dialogresult = Text1.Text
    Unload Me
End Sub

Lomake (Form1)
'BorderStyle 1 - FixedSingle
' StartUpPosition 2 - CenterScreen

'Ohjausobjektit:
'1 MSFlexGrid (MSFlexGrid1)
'asetukset:
'Rows 2, Cols 2
'Fixed Rows 1, Fixed Cols 1
'ScrollBars 3 - Both
'FocusRect 2 - Heavy
'HighLight 1 -Always
'MousePointer 0 - Default
'FillStyle 0 - Single
'SelectionMode 0 - Free
'AllowUserResizing 3 - Both

'2 komentopainiketta (Command1 & Command2)
'1 Label (Label1)

Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim row As Integer
Dim col As Integer
Dim sql As String

Dim cat As adox.Catalog
Dim tbl As adox.Table
Dim xcol As adox.Column

Dim ColLetter() As String

Private Sub Form_Load()

    Dim i As Integer

    If Dir("C:\xlsamples\xlsample1.xls") = "" Then


        Set cat = New adox.Catalog
        Dim colNames() As String
        colNames = Split(",ID,Pvm,Data", ",") 'esim.

        'Excel 2000 - 2003 tiedostot
        'cat.ActiveConnection = _
        '"Provider=Microsoft.Jet.OLEDB.4.0;" & _
        '"Data Source=C:\xlsamples\xlsample1.xls;" & _
        '"Extended Properties=Excel 8.0"

        'Excel 2007 - 2010 tiedostot
        cat.ActiveConnection = _
        "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=C:\xlsamples\xlsample1.xls;" + _
        "Extended Properties=Excel 12.0"

        Set tbl = New adox.Table
        tbl.Name = "Taul1"

        For i = 1 To 3
            Set xcol = New adox.Column
            With xcol
                .Name = colNames(i)
                .Type = adVarWChar
            End With
            tbl.Columns.Append xcol
            Set xcol = Nothing
        Next i

        cat.Tables.Append tbl
        Set tbl = Nothing

        Set cat = Nothing
        Erase colNames

    End If

    Dim connstr As String
    connstr = "Provider=Microsoft.ACE.OLEDB.12.0;" + _
    "Data Source=C:\xlsamples\xlsample1.xls;" + _
    "Extended Properties=""Excel 12.0;HDR=No;"""

    'Excel 2000 - 2003 tiedostot
    '"Provider=Microsoft.Jet.OLEDB.4.0;" & _
    '"Data Source=C:\xlsamples\xlsample1.xls;" & _
    '"Extended Properties=Excel 8.0;HDR=No;"""

    sql = "SELECT * FROM [Taul1$];"
    Set conn = New ADODB.Connection
    conn.Mode = adModeShareExclusive
    conn.ConnectionString = connstr
    conn.Open

    Set rs = New ADODB.Recordset
    rs.Open sql, conn, adOpenDynamic, adLockOptimistic, 1

    MSFlexGrid1.Cols = rs.Fields.Count + 1

    Dim rw As Integer: rw = 1

    MSFlexGrid1.ColWidth(0) = 500

    ReDim ColLetter(25) As String

    For i = 65 To 90
        ColLetter(i - 65) = Chr(i)
    Next i

    MSFlexGrid1.ColAlignment(0) = flexAlignCenterCenter

    For i = 1 To MSFlexGrid1.Cols - 1
        MSFlexGrid1.TextMatrix(0, i) = ColLetter(i - 1)
        MSFlexGrid1.FixedAlignment(i) = flexAlignCenterCenter
    Next i

    RsAction

    Command1.Caption = "Lisää uusi rivi"
    Command2.Caption = "Poista rivi"
    Command2.Visible = False

    MSFlexGrid1.row = 0

End Sub

Private Sub Form_Unload(Cancel As Integer)

    On Error Resume Next
    rs.Close
    conn.Close
    Set rs = Nothing
    Set conn = Nothing

End Sub

Private Sub MSFlexGrid1_Click()

    If MSFlexGrid1.MouseCol = 0 _
    And MSFlexGrid1.MouseRow > 1 Then
        Command2.Visible = True
    Else
        Command2.Visible = False
    End If

    Label1.Caption = ""

End Sub

Private Sub MSFlexGrid1_DblClick()

    If row = 0 Or col = 0 Or _
    MSFlexGrid1.MouseCol = 0 Or _
    MSFlexGrid1.MouseRow = 0 Then
        Exit Sub
    End If

    Static tagValue As String
    tagValue = MSFlexGrid1.TextMatrix(row, col)

    Dialog.Caption = "Muuta solun (" & _
    ColLetter(col - 1) & CStr(row) & ") arvoa"

    Dialog.Text1.Text = tagValue
    Dialog.Show 1

    If dlgResult <> "__CANCEL" And dlgResult <> tagValue Then

        MSFlexGrid1.TextMatrix(row, col) = dlgResult
        rs.MoveFirst

        For i = 0 To row - 2
            rs.MoveNext
        Next i

        rs.Fields(col - 1).Value = dlgResult
        rs.Update

    End If

End Sub

Private Sub MSFlexGrid1_EnterCell()

    row = MSFlexGrid1.row
    col = MSFlexGrid1.col

End Sub

Private Sub Command1_Click()

    Dim i As Integer

    rs.AddNew
    For i = 0 To rs.Fields.Count - 1
        rs.Fields(i) = ""
    Next

    rs.Update
    RsAction

    Label1.Caption = "Kaksoisnapauta hiirellä solua jonka arvoa haluat muuttaa"

End Sub

Private Sub Command2_Click()

    Dim i As Integer
    Dim colNames() As String
    colNames = Split(",ID,Pvm,Data", ",") 'esim.

    rs.Close: Set rs = Nothing
    conn.Close: Set conn = Nothing

    Kill "c:\xlsamples\xlsample1.xls"

    Set cat = New adox.Catalog
    cat.ActiveConnection = _
    "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=C:\xlsamples\xlsample1.xls;" & _
    "Extended Properties=Excel 12.0"

    Set tbl = New adox.Table
    tbl.Name = "Taul1"

    For i = 1 To 3
        Set xcol = New adox.Column
        With xcol
            .Name = colNames(i)
            .Type = adVarWChar
        End With
        tbl.Columns.Append xcol
        Set xcol = Nothing
    Next i

    cat.Tables.Append tbl

    Set tbl = Nothing
    Set cat = Nothing

    MSFlexGrid1.RemoveItem (row)

    Dim connstr As String
    connstr = "Provider=Microsoft.ACE.OLEDB.12.0;" + _
    "Data Source=C:\xlsamples\xlsample1.xls;" + _
    "Extended Properties=""Excel 12.0;HDR=no;"""

    Set conn = New ADODB.Connection
    conn.Mode = adModeShareExclusive
    conn.Open connstr
    Set rs = New ADODB.Recordset
    rs.Open sql, conn, adOpenDynamic, adLockOptimistic, 1

    For i = 2 To MSFlexGrid1.Rows - 1
        rs.AddNew
        For j = 1 To MSFlexGrid1.Cols - 1
            rs.Fields(j - 1).Value = MSFlexGrid1.TextMatrix(i, j)
        Next
        rs.Update

    Next

    MSFlexGrid1.Clear
    RsAction

End Sub

Private Sub MSFlexGrid1_LostFocus()
    Label1.Caption = ""
End Sub

Sub RsAction()

    rs.MoveFirst

    Dim rw As Integer: rw = 1

    Do While Not rs.EOF

        rw = rw + 1
        MSFlexGrid1.Rows = rw
        On Error Resume Next
        MSFlexGrid1.TextMatrix(rw - 1, 0) = rw - 1

        For i = 1 To MSFlexGrid1.Cols
            MSFlexGrid1.TextMatrix(rw - 1, i) = rs.Fields(i - 1).Value
        Next i

        rs.MoveNext

    Loop

End Sub

'Lomake (Dialog)
'BorderStyle 3 - FixedDialog
'ClipControls False
'ControlBox False
'StartUpPositon 2 - CenterScreen

'Ohjausobjektit:
'1 tekstiruutu (Text1)
'2 komentopainiketta (OKButton & CancelButton)

Option Explicit

Private Sub Form_Load()
    Text1.Text = ""
End Sub

Private Sub CancelButton_Click()
    dlgResult = "__CANCEL"
    Unload Me
End Sub

Private Sub OKButton_Click()
    dlgResult = Text1.Text
    Unload Me
End Sub

Dim a As Variant
Dim b As Integer
Dim GpsLong As Currency
Dim GpsLati As Currency
Dim GpsSat As Integer

Private Sub GPSDataFind()
Dim i As Integer, m As Integer
Dim StrLati As String, ModStrLati As String * 8
Dim StrLong As String, ModStrLong As String * 8


If b < 1 Then                                           'tarkastaa GPS;ltä tulevan datan
    Label4.Caption = "Ei yhteyttä GPS palikkaan"
    Exit Sub
    Else
    Label4.Caption = "Yhteys GPS palikkaan olemassa "

End If

For i = 0 To b
    If a(i) = "$GPGGA" Then                             'etsii datasta oikeaa tietoa
        If a(i + 2) <> "" Then
        StrLati = a(i + 2)
        StrLong = a(i + 4)
            For m = 0 To 3
            ModStrLati(m) = StrLati(m)                  'yrittää erottaa datasta 4 viimeistä merkkiä ja siirtää toiseen stringiin
            ModStrLong(m) = StrLong(m)
            Next m
            For m = 4 To 7
            ModStrLati(m) = StrLati(m + 1)              'tällä piti saada piste pois stringistä.
            ModStrLong(m) = StrLong(m + 1)
            Next m



        Label3.Caption = ModStrLati & " " & ModStrLong
        Else
        Label3.Caption = " ei yhteyttä sateliittiin"
        End If

    End If
Next i



End Sub

Private Sub Command1_Click()
MSComm1.PortOpen = True
Timer1.Enabled = True


End Sub

Private Sub Command2_Click()
Timer1.Enabled = False
MSComm1.PortOpen = False

End Sub

Private Sub Text1_Change()

End Sub

Private Sub Timer1_Timer()


Dim PlaceD As String
PlaceD = MSComm1.Input

a = Split(PlaceD, ",", , vbTextCompare)

b = UBound(a)

'Label4.Caption = b
'Label3.Caption = PlaceD
GPSDataFind


End Sub

Private Sub ShowGPSData(gpsArray As Variant, IsMulti As Boolean)

   Dim i As Integer

   Select Case IsMulti
      'tapauksessa että parametrin
      'IsMulti arvo on EPÄTOSI niin...
      Case False
         'käydään laskurisilmukassa läpi parametrin
         'gpsArray taulukon kaikki alkiot...
         For i = LBound(gpsArray) To UBound(gpsArray)
            'jos laskurin i osoitaman alkioindeksin
            'merkkijono ei ole tyhjä niin...
            If Trim(gpsArray(i)) <> "" Then

               'muutama esimerkki stringin käsittelystä
               'poistaa kaikki pisteet
               'gpsArray(i) = Replace(gpsArray(i),".","")

               'poistaa merkit oikealta alkaen pisteestä
               'If InStr(gpsArray(i), ".") > 1 Then
                  'gpsArray(i) = Left(gpsArray(i), _
                  'InStr(gpsArray(i), ".") - 1)
               'End If

               'poistaa merkit vasemmalta alkaen pisteestä
               'If InStr(gpsArray(i), ".") > 1 Then
                  'gpsArray(i) = Right(gpsArray(i), _
                  'Len(gpsArray(i)) - InStr(gpsArray(i), "."))
               'End If

               'näytetään taulukon, laskurin i
               'osoittaman alkioindeksin, merkkijono
               MsgBox gpsArray(i)

            End If
         Next i
      Case True
         'tapauksessa että parametrin
         'IsMulti arvo on TOSI niin...

         'märiteään laskurin i osoittaman
         'arvon perusteella taulukon gpsArray
         'ensimmäisen ulottuvuuden indeksi...
         For i = LBound(gpsArray, 1) To UBound(gpsArray, 1)
            Dim j As Integer
            'ja laskurin j osoittaman arvon
            'perusteella taulukon gpsArray
            'toisen ulottuvuuden indeksi...
            For j = LBound(gpsArray, 2) To UBound(gpsArray, 2)
               If Trim(gpsArray(i, j)) <> "" Then
                  'ja näytetään lakuriarvojen
                  'osoittaman alkion merkkijono.
                  MsgBox gpsArray(i, j)
               End If
            Next j
         Next i
   End Select

End Sub
Private Sub Command1_Click()

   MSComm1.PortOpen = True
   Timer1.Enabled = True

End Sub

Private Sub Command2_Click()

   Timer1.Enabled = False
   MSComm1.PortOpen = False

End Sub

Private Sub Timer1_Timer()

   Dim retArray As Variant
   Dim IsMulti As Boolean
   Dim PlaceD As String

   PlaceD = MSComm1.Input

   If InStr(PlaceD, vbCrLf) > 0 Then

      Dim i As Integer, j As Integer
      Dim cnt As Integer: cnt = -1
      Dim tmpArray() As String
      'jos muuttujan PlaceD merkkijono sisältää
      'rivinvihtomerkkejä niin splitataan muutujan
      'merkkijono string taulukkoon (tmpArray)
      tmpArray = Split(PlaceD, vbCrLf)

      'alustetaan kasiolotteinen merkkijono taulukko
      'ja määritetään taulukon ensimäisen ulottuvuuden
      'kooksi merkkijonotaulukon (tmpArray) koko ja
      'ja toisen ulottuvuuden kooksi 0 (yksi alkioindeksi)
      ReDim gpsArray(UBound(tmpArray), 0) As String

      For i = LBound(tmpArray) To UBound(tmpArray)
         'jos taulukkon tmpArray laskuriarvon i
         'osottaman alkion merkkijono sisältää
         'merkkijonon "$GPGGA"  niin...
         If InStr(tmpArray(i), "$GPGGA") > 0 Then
            'jos samaisen alkion merkkijono
            'sisältää pilkkuja niin splitataan
            'alkion merkkijono string taulukkoon (tmp2Array)
            If InStr(tmpArray(i), ",") > 0 Then

               'alustetaan merkkijonotaulukko
               Dim tmp2Array() As String
               'ja splitataan taulukkoon tmp2Array
               'merkkijonotaulukon tmpArray laskurin
               'osittaman alkioindeksin merkkijono
               'käyttäen erottimena pilkku merkkiä
               tmp2Array = Split(tmpArray(i), ",")

               For j = LBound(tmp2Array) To UBound(tmp2Array)
                  'jos laskurin j arvo on suurempi kuin
                  'taulkon gpsArray toisen ulottuvuuden
                  'ylin indeksi niin..
                  If j > UBound(gpsArray, 2) Then
                     'kasvatetaan taulukon toisen
                     'ulotuvuuden kokoa laskurin
                     'j osoittamalla arvolla
                     ReDim Preserve gpsArray(UBound(gpsArray, 1), j)
                  End If

                  'asetetaan taulukon, laskurien i ja j
                  'osoittaman alkioindeksin arvoksi
                  'taulukon tmp2Array laskurin j osittaman
                  'alkioindeksin merkkijonoarvo
                  gpsArray(i, j) = tmp2Array(j)

               Next j

               'pyhkäistään aputaulukko tmp2Array muistista
               Erase tmp2Array

            End If
         End If
      Next i

      'jos merkkijonotaulukon gpsArray
      'toisen ulottuvuuden koko on 0
      If UBound(gpsArray, 2) = 0 Then
         'niin ilmoitetaan käyttäjälle
         'että GPS dataa ei ole...
         MsgBox "Ei GPS dataa!"
         'poistetaan taulukot muistista
         Erase tmpArray, gpsArray
         'ja poistutaan aliohjelmasta.
         Exit Sub
      End If

      'asetetaan variant tyyppisen muuttujan
      '(retArray) arvoksi taulukko (gpsArray)
      retArray = gpsArray

      'kutsutaan aliohjelmaa ShowGPSData
      'ja välitetään aliohjelmalle parametreinä
      'variant muuttuja retArray ja boolen
      'operaattorin arvo TRUE joka ilmoittaa
      'aliohjelmalle tässä tapauksessa, että
      'ensimmäinen paramtriarvo sisältää
      'kaksiulotteisen taulukon...

      GPSDataShow retArray, True
      'pyhkäistään taulukot muistista
      Erase tmpArray, gpsArray, retArray
   Else
      'Jos muuttujan PlaceD merkkijono ei
      'sisältänyt rivinvaihtomerkkejä niin
      'tutkitaan sisältääkö merkkijono
      '"$GPGGA" merkkijonon...
      If InStr(PlaceD, "$GPGGA") > 0 Then

         'ja jos merkkijono sisältää pilkun
         If InStr(PlaceD, ",") > 0 Then
            'splitataan merkkijono variant
            'muuttujaan retArray...
            retArray = Split(PlaceD, ",")
            'kutsataan aliohjelmaa ShowGPSData
            'välitetään aliohjelmalle parametreinä
            'variant muuttuja retArray ja boolen
            'operaattorin arvo FALSE joka ilmoittaa
            'aliohjelmalle tässä tapauksessa, että
            'ensimmäinen paramtriarvo sisältää
            'yksiulotteisen merkkijonotaulukon.
            ShowGPSData retArray, False
            Erase retArray
         Else
            'jos merkkijono ei sisältänyt pilkkua
            'niin ilmoitetaan käyttäjälle, että
            'GPS dataa ei ole
            MsgBox "Ei GPS dataa!"
         End If
      Else
         'jos merkkijono ei sisältänyt
         '"$GPGGA" merkkijonoa niin
         'ilmoitetaan käyttäjälle, että
         'GPS dataa ei ole
         MsgBox "Ei GPS dataa!"
      End If
   End If

End Sub