Keskustelu: Ohjelmointikysymykset: VB6 + Excel (VBA)

Option Explicit

Private Sub Command1_Click()
    Dim objExcel As Object
    Dim objWorkbook As Excel.Workbook
    Dim solu As Excel.Range
    Dim ala As Excel.Range
    Dim osa As Excel.Range
    Dim path As String
    Dim osat() As String
    Dim pvm() As String
    Dim i As Integer

    'alustetaan taulukkomuuttuja
    ReDim pvm(1, 0)
    'määritetään polku tiedostomme luo
    path = "C:\Documents and Settings\bad\My Documents\Test.xls"
    'luodaan excel-muuttuja, jonka kautta kaikki loput exceliin viittaavat muuttujat luodaan
    Set objExcel = CreateObject("EXCEL.APPLICATION")
    'avataan haluamamme excel-tiedosto
    Set objWorkbook = objExcel.Workbooks.Open(path)
    'etsitään tiedostosta kaikki solut, joissa on arvo/tietoa
    Set ala = objWorkbook.Sheets(1).Cells.SpecialCells(xlCellTypeConstants, 23)
    'jos ala sisältää useita erillisiä alueita sivulla,
    'niin ne on eroteltu pilkulla Address:ssa.
    'jos pilkkua ei ole (pelkästään yksi alue),
    'niin osat saa arvokseen tuon Addressin arvon sellaisenaan
    osat = Split(Replace(ala.Address, "$", ""), ",")
    'käydään osat läpi osa kerrallaan
    For i = 0 To UBound(osat)
        Set osa = Excel.Range(osat(i))
        'tarkistetaan osan solut eksi kerrallaan että sisältääkö se päivämäärää
        For Each solu In osa
            If IsDate(solu.Value) Then
                'päivämäärä löytyi, joten tarkistetaan,
                'onko pvm-taulukossa ennestään arvoa viimeisimmässä solussa.
                'jos viimeisin on varattu, niin lisätään taulukkoon lisää tilaa
                If LenB(pvm(0, UBound(pvm, 2))) > 0 Then _
                  ReDim Preserve pvm(1, UBound(pvm, 2) + 1)
                'otetaan talteen päivämäärän sisältäneen solun arvo
                pvm(0, UBound(pvm, 2)) = solu.Value
                'otetaan päivämäärää seuraavasta sarakkeesta talteen arvo
                pvm(1, UBound(pvm, 2)) = solu.Offset(0, 1).Value
            End If
        Next solu
    Next i
    'suljetaan avaamamme excel-tiedosto.
    'False vastaa kysymykseen "Tallennetaanko muutokset?", jos sellaista kysyttäisiin
    objWorkbook.Close False
    'tulostetaan pvm-taulukon arvot Immediate-ikkunaan VB:n puolella
    For i = 0 To UBound(pvm, 2)
        Debug.Print pvm(0, i) & ": " & pvm(1, i)
    Next i
    ' Vapautetaan muuttujien varaama muisti
    Set solu = Nothing
    Set osa = Nothing
    Set ala = Nothing
    Set objWorkbook = Nothing
    Set objExcel = Nothing
End Sub