How to send data from VB program to Excel spreadsheet directly

How to send data from a VB program to Excel spreadsheet directly

UltimaSerial

The following is a step-by-step lesson on how to send data from a VB program to Excel spreadsheet directly

In this lesson, we will use Ultimaserial ActiveX to develop a data acquisition application with DATAQ's Starter kit.

In UltimaSerial download, you will find the VB sample program (AnalogWaveformExel) that demonstrates how to send data from VB program to Excel spreadsheet directly.

To send data from VB to Excel spreadsheet directly, you need to

1) Invoke Excel: Set oExcel = CreateObject("Excel.Application")

2) Add a workbook: Set oBook = oExcel.Workbooks.Add

3) Specify a spreadsheet: Set oSheet = oBook.Worksheets(1)

4) Send the data: oSheet.Range(s$).Resize(Val(Text1.Text), 1).Value = dataarray

Here is the source code:

Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object
'------------------------------------------------------------------------------------------
'This program demostrate how to acquire data and display in a scrolling waveform,
'you can also send data to excel!
'
'For DI-148/158/710 series support, please visit www.ultimaserial.com first
'
'------------------------------------------------------------------------------------------
Private Sub Form_Load()

'For DI-148/158/710 series support, please visit www.ultimaserial.com first

List1.AddItem "150RS" 'Devices
List1.AddItem "151RS"
List1.AddItem "194"
List1.AddItem "195B"
List1.AddItem "154RS"
List1.AddItem "148U"
List1.AddItem "158U"
List1.AddItem "710U"
List1.AddItem "715U"

Combo1.AddItem "1" 'COM port
Combo1.AddItem "2"
Combo1.AddItem "USB"
End Sub

Private Sub Command1_Click()
UltimaSerial.Device = Val(List1.Text)
UltimaSerial.CommPort = Val(Combo1.Text)
UltimaSerial.AcquisitionMode = NoCondition
UltimaSerial.ChannelCount = 4

UltimaSerial.SampleRate = Val(Text3.Text)
UltimaSerial.EventLevel = 2 'Chart it when we have 2 or more points.
UltimaSerial.Start

Label4.Caption = "Serial Number: " + UltimaSerial.SerialNumber
Text3.Text = UltimaSerial.SampleRate
End Sub

Private Sub Text1_Change()
If Val(Text1.Text) <= 0 Then Text1.Text = 1
If Val(Text1.Text) >= 1000 Then Text1.Text= 1000
Text1.Text = Int(Val(Text1.Text))
s$ = Format$(Val(Text1.Text))
Command3.Caption = "Send " + s$ + " data# to Excel!"
End Sub

Private Sub UltimaSerial_NewData(ByVal Count As Integer)
v = UltimaSerial.GetData() 'Get data
DQChart1.Chart (v) 'Chart all channels

End Sub

Private Sub Command2_Click()
UltimaSerial.Stop
End Sub

Private Sub Command3_Click()

v = UltimaSerial.GetDataFrame(Val(Text1.Text))

If CheckReuseSheet.Value = 0 Then
Set oBook = oExcel.Workbooks.Add
Set oSheet = oBook.Worksheets(1)
Else
Set oSheet = oBook.Worksheets(1)
If bClearSheet Then
oSheet.cells.Clear
End If
End If

oSheet.Application.Visible = True

For i = 0 To UltimaSerial.ChannelCount - 1
oSheet.Range(Chr$(Asc("A") + i) + "1").Value = "Chn " + Format$(i)
oSheet.Range(Chr$(Asc("A") + i) + "2").Value = "Counts"
Next

If CheckTimeStamp.Value = 1 Then
oSheet.Range(Chr$(Asc("A") + i) + "1").Value = Array("Time")
oSheet.Range(Chr$(Asc("A") + i) + "2").Value = Array("sec")
End If

oSheet.Range("A3").Resize(Val(Text1.Text), UltimaSerial.ChannelCount).Value = oExcel.Worksheetfunction.Transpose(v)
If CheckTimeStamp.Value = 1 Then
ReDim dataarray(1 To Val(Text1.Text), 1 To 1) As Variant
For i = 1 To Val(Text1.Text)
dataarray(i, 1) = (i - 1) / UltimaSerial.SampleRate
Next
s$ = Chr$(Asc("A") + UltimaSerial.ChannelCount) + "3"
oSheet.Range(s$).Resize(Val(Text1.Text), 1).Value = dataarray
End If

End Sub

Private Sub Command4_Click()
Set oExcel = CreateObject("Excel.Application")
oExcel.Application.Visible = True

Set oBook = oExcel.Workbooks.Add

End Sub

Last update: 04/08/10