Keskustelu: Ohjelmointikysymykset: VBA: VB:n ja Excelin linkitys

Private Sub Command1_Click()

  Dim ctl As Control

  For Each ctl In Form1.Controls
    With ctl
      If InStr(.Name, "Label") > 0 Then
        If .LinkItem <> "" Then
          .Caption = Str(Val(.Caption) + 1)
          .LinkMode = 1 'Manual
          .LinkPoke
        End If
      End If
    End With
  Next

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Cells.Range("A2:" & _
      Replace(Cells.SpecialCells(xlCellTypeLastCell) _
      .Address, "$", "")).Select
Dim solu
For Each solu In Cells.Range("A2:" _
& Replace(Cells.SpecialCells(xlCellTypeLastCell) _
.Address, "$", ""))
    With solu
      If Not IsEmpty(.Value) Then .Value = "-"
    End With
  Next
  ActiveWorkbook.Save
  Saved = True
End Sub

Private Sub Command1_Click()

Dim i As Integer, version As Integer
Dim BaseFolder As String, xlFolder As String

version = 8:
BaseFolder = "C:\Ohjelmatiedosto\"
xlFolder = "Office"

  For i = 0 To 8
    Label1(i).Caption = Val(Label1(i).Caption) + i + 1
  Next i

  Data1.Refresh

  CheckExcelState

Ret:

  On Error GoTo ErrorHandler
  Shell (BaseFolder & "Microsoft Office\" & _
  xlFolder & "\Excel.exe " & Chr(34) & _
  Data1.DatabaseName & Chr(34)), vbMaximizedFocus

  End

Exit_Proc:

Exit Sub

ErrorHandler:

  Select Case Err
    Case 76
      Err.Clear
      BaseFolder = "C:\Program files\"
      Resume: GoTo Ret
    Case Else
  End Select

  Err.Clear
  version = version + 1
  xlFolder = "Office" & CStr(version)

  If version = 16 Then
    MsgBox "Exceliä ei löydy Microsoft Officen" & _
    " oletusasennushakemistosta" _
    , vbExclamation, "Viestiloota"
    GoTo Exit_Proc
  End If
  Resume: GoTo Ret

End Sub

Sub CheckExcelState()

'referenssi: Microsoft WMI Scripting V1.2 Library
'(C:\WINDOWS\system32\wbem\wbemdisp.TLB)
Dim wmiService As SWbemObjectSet
Dim wmiProcess As SWbemObject

Set wmiService = GetObject _
  ("winmgmts:{impersonationLevel=impersonate}") _
  .InstancesOf("Win32_process")


  For Each wmiProcess In wmiService
    With wmiProcess
      If LCase(.Name) = "excel.exe" Then
        .Terminate
      End If
    End With
  Next

  Set wmiService = Nothing

End Sub

Private Sub Command1_Click()
    Dim xlApp As New Excel.Application
    Dim xlBook As New Excel.Workbook
    Dim xlSheet As New Excel.Worksheet
    Set xlApp = CreateObject("excel.application")
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)

    'tehdään otsikot
    xlSheet.Range("a1").Value = "päivämäärä"
    xlSheet.Range("b1").Value = "numero1"
    xlSheet.Range("c1").Value = "numero2"
    'jnejne....

    'luodaan 'dataa'
    xlSheet.Range("a2").Value = "11.11.2007"
    xlSheet.Range("b2").Value = "5"
    xlSheet.Range("c2").Value = "5"
    'jnejne

    'näytetään excel
    xlApp.Visible = True

    'tallennetaan excel
    'xlSheet.SaveAs ("c:\temp\tiedosto.xls")
    'xlApp.Quit

End Sub

Private Sub avaa_excel_1()

    Set excelsheet = GetObject("d:\koulujuttui\visual basic\harkkatyö\lotto.xls")
        excelsheet.application.Visible = False
        excelsheet.Parent.windows(1).Visible = True

    Call tallenna_lotto_tulokset_exceliin     ' Kutsutaan aliohjelma_tallenna_lotto_tulokset

End Sub

Sub tallenna_lotto_tulokset_exceliin()
    Dim sarake As Integer
    Dim rivi As Integer



    ' etsitään seuraava vapaa rivi
    sarake = 1
    rivi = 6
    Do Until excelsheet.application.cells(rivi, sarake) = ""
        rivi = rivi + 1
    Loop
    '---------------------------------------
    ' tallennetaan henkilön tiedot taulukkoon
    excelsheet.application.cells(rivi, 1) = Now()
    excelsheet.application.cells(rivi, 2) = lottonumero(0)
    excelsheet.application.cells(rivi, 3) = lottonumero(1)
    excelsheet.application.cells(rivi, 4) = lottonumero(2)
    excelsheet.application.cells(rivi, 5) = lottonumero(3)
    excelsheet.application.cells(rivi, 6) = lottonumero(4)
    excelsheet.application.cells(rivi, 7) = lottonumero(5)
    excelsheet.application.cells(rivi, 8) = lottonumero(6)
    excelsheet.application.cells(rivi, 9) = lottonumero(7)
    excelsheet.application.cells(rivi, 10) = lottonumero(8)
    excelsheet.application.cells(rivi, 11) = lottonumero(9)

    Call tallenna_excel

End Sub

Private Sub tallenna_excel()

    excelsheet.application.displayalerts = False
    excelsheet.saveas "d:\koulujuttui\visual basic\harkkatyö\lotto.xls"
    excelsheet.application.quit
    Set excelsheet = Nothing

End Sub