UltimaSerial How to send data from a VB program to OpenOffice.org Calc directly
 
Data logger
UltimaSerial

 

Windaq add-ons
Windaq Add-ons

 

Spectrogram
UltimaWaterfall

 

Ultimaserial XChart
XChart

 

FFT1024
FFT1024

 

Ultimaserial Classroom
Lessons

 

The following is the source codes from Windaq Add-on OpenOfficeCalcLink . It demonstrates how to write a program in VB to send data to OpenOffice.org Calc directly.

  • To star OpenOffice.org Calc, invoke the following
    • Set oSM = CreateObject("com.sun.star.ServiceManager")
    • Set oDesk = oSM.createInstance("com.sun.star.frame.Desktop")
    • Set oDoc = oDesk.loadComponentFromURL("private:factory/scalc", "_blank", 0, arg)
  • To close OpenOffice.org Calc, invoke oDoc.Close (True)
  • To clear portion of a sheet, invoke the following
    • Set oRange = oSheet.getCellRangeByName("A1:B12")
    • oRange.clearContents (5), where 5 is the sum of the following flags
      • 1 - value
      • 2 - date, time
      • 4 - strings
      • 8 - annotation
      • 16 - formula
      • 32 - hardattr
      • 64 - styles
      • 128 - objects
  • To write a text string to a cell, call oSheet.getCellRangeByName("A2").setString ("test") 
  • To write a number to a cell, call oSheet.getCellRangeByName("A2").setValue (16)
  • Here are  the codes

Dim oSM As Object
Dim oSheet As Object
Dim oDesk As Object
Dim oDoc As Object
Dim col As Integer
Dim oFrame As Integer
Dim oWindow As Integer
Dim bClearSheet As Integer
Dim bRunning As Boolean
Dim oCells As Object
Dim arg()

Private Sub CheckAllChannel_Click()
bClearSheet = 1
End Sub

Private Sub CheckTimeStamp_Click()
bClearSheet = 1
End Sub

Private Sub Command2_Click()
v = WinDaq1.GetDataFrame(Val(Text2), FormatScaled)

If bClearSheet Then
    Dim oRange As Object
    Set oRange = oSheet.getCellRangeByName("A1:" + Chr$(Asc("B") + WinDaq1.ChannelCount + 1) + Format$(Text2.Text))
    oRange.clearContents (5)
End If

If CheckAllChannel.Value = 0 Then
    oSheet.getCellRangeByName("A1").setString ("Chn " + Format$(WinDaq1.GetPhysicalChannel(Val(Text1)))) 
    oSheet.getCellRangeByName("A2").setString (WinDaq1.GetUnit(Val(Text1))) 
    i = 1
Else
    For i = 0 To WinDaq1.ChannelCount - 1
        oSheet.getCellRangeByName(Chr$(Asc("A") + i) + "1").setString ("Chn " + Format$(WinDaq1.GetPhysicalChannel(i))) 
        s$ = Chr$(Asc("A") + i) + "2"
        S2$ = Chr$(Asc("B") + i) + "3"
        oSheet.getCellRangeByName(s$).setString (WinDaq1.GetUnit(Val(Text2))) 
    Next
End If

If CheckTimeStamp.Value = 1 Then
    oSheet.getCellRangeByName(Chr$(Asc("A") + i) + "1").setString ("Time") 
    oSheet.getCellRangeByName(Chr$(Asc("A") + i) + "2").setString ("Sec")
End If


If CheckAllChannel.Value = 0 Then
    If CheckTimeStamp.Value = 1 Then
        For i = 1 To Val(Text2)
            oSheet.getCellRangeByName("A" + Format$(i + 2)).setValue (v(Val(Text1), i - 1)) 
            oSheet.getCellRangeByName("B" + Format$(i + 2)).setValue ((i - 1) / WinDaq1.SampleRate) 
        Next
    Else
        For i = 1 To Val(Text2)
            oSheet.getCellRangeByName("A" + Format$(i + 2)).setValue (v(Val(Text1), i - 1)) 
        Next
    End If
Else
  
    If CheckTimeStamp.Value = 1 Then
        For i = 1 To Val(Text2)
            For j = 0 To WinDaq1.ChannelCount - 1
                oSheet.getCellRangeByName(Chr$(Asc("A") + j) + Format$(i + 2)).setValue (v(j, i - 1)) 
            Next
            oSheet.getCellRangeByName(Chr$(Asc("A") + j) + Format$(i + 2)).setValue ((i - 1) / WinDaq1.SampleRate) 
        Next
    Else
        For i = 1 To Val(Text2)
            For j = 0 To WinDaq1.ChannelCount - 1
                oSheet.getCellRangeByName(Chr$(Asc("A") + j) + Format$(i + 2)).setValue (v(j, i - 1)) 
            Next
        Next
    End If
End If

bClearSheet = 0


End Sub
Private Sub Form_Load()
Dim S1 As String
Dim S2 As String
Dim inFoundPos As Integer
Dim inCounter As Integer

bClearSheet = 1
bRunning = False

'The format is -DDIxxxNT.DLL -Nxxx -In
If Len(Command$) > 0 Then
    sTemp = Split(Command$, " ")
    i = UBound(sTemp, 1)
    If Mid$(sTemp(0), 1, 1) = "-" And UCase(Mid$(sTemp(0), 2, 1)) = "D" Then
        WinDaq1.DeviceDriver = Mid$(sTemp(0), 3, Len(sTemp(0)) - 2)
    End If
    If i > 0 Then
        If Mid$(sTemp(1), 1, 1) = "-" And UCase(Mid$(sTemp(1), 2, 1)) = "N" Then
            Form1.Caption = Replace$(Mid$(sTemp(1), 3, Len(sTemp(1)) - 2), "_", " ")
            mycaption = Replace$(Mid$(sTemp(1), 3, Len(sTemp(1)) - 2), "_", " ")
        End If
        If i > 1 Then
            If Mid$(sTemp(2), 1, 1) = "-" And UCase(Mid$(sTemp(2), 2, 1)) = "I" Then
                If Val(Mid$(sTemp(2), 3, Len(sTemp(2)) - 2)) <> -1 Then
                    Text1.Text = Mid$(sTemp(2), 3, Len(sTemp(2)) - 2)
                End If
            End If
        End If
    End If
End If


WinDaq1.Start
bRunning = True
Set oSM = CreateObject("com.sun.star.ServiceManager")
Set oDesk = oSM.createInstance("com.sun.star.frame.Desktop")
Set oDoc = oDesk.loadComponentFromURL("private:factory/scalc", "_blank", 0, arg)

Set oSheet = oDoc.getSheets().getByIndex(0)

End Sub
Private Sub Form_Unload(Cancel As Integer)
If CheckCloseExcelOnExit.Value = 1 Then
    oDoc.Close (True)
End If
End Sub

Private Sub Text1_Change()
If Val(Text1.Text) < 0 Then Text1.Text = 0

If bRunning Then
    If Val(Text1.Text) >= WinDaq1.ChannelCount Then Text1.Text = WinDaq1.ChannelCount - 1
End If

End Sub

Private Sub Text2_Change()
bClearSheet = 1
End Sub

Private Sub WinDaq1_WinDaqExit()
'MsgBox "Please run Windaq first"
End
End Sub

Last update: 02/24/12

Copyright: 2000-2005  www.UltimaSerial.com