PDA

View Full Version : [SOLVED] Time Loop



ahs_89
03-12-2017, 01:57 PM
Good Evening.

I need your help with a macro that has to do with time. I have tried to solve it own my own but is very difficult considering I am a beginner.

I am working with a temperature logger to control the temperature of a material in time.
This Interrogator shows me only live value in the same cell of excel updating on a defined time (like every 1 min).
I needed to store the variation to be able to see how the temperatures evolves in days.

My idea was to write a macro that copy every minute (or other defined time) this live cell and to paste it on another sheet one row after another and also coping the time on which that value was recorded.

The Interrogator is controlled by Macro. So I am pasting also the code of that because could by helpful.

Declare PtrSafe Function usb_tc08_set_channel Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer, ByVal channel As Integer, ByVal tc_type As Byte) As Integer


Declare PtrSafe Function usb_tc08_run Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer, ByVal interval_ms As Long) As Long


Declare PtrSafe Function usb_tc08_get_temp Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer, ByRef temp_buffer As Single, ByRef times_ms_buffer As Long, ByVal buffer_length As Long, ByRef overflow, ByVal channel As Integer, units As Integer, ByVal fill_missing As Integer) As Long


Declare PtrSafe Function usb_tc08_get_temp_deskew Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer, ByRef temp_buffer As Single, ByRef times_ms_buffer As Long, ByVal buffer_length As Long, ByRef overflow, ByVal channel As Integer, ByVal units As Integer, ByVal fill_missing As Integer) As Long
Declare PtrSafe Function usb_tc08_get_single Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer, ByRef temp As Single, ByRef overflow_flags, ByVal units As Integer) As Long


'==========================================================================
' Shared API Calls


' These functions are designed for use with the USB TC08,
' however, they can (and should) still be used with the legacy API calls
'========================================================================== =*/


Declare PtrSafe Function usb_tc08_open_unit Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" () As Integer


Declare PtrSafe Function usb_tc08_close_unit Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer) As Integer


Declare PtrSafe Function usb_tc08_stop Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer) As Integer


Declare PtrSafe Function usb_tc08_set_mains Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer, ByVal sixty_hertz As Integer) As Integer


Declare PtrSafe Function usb_tc08_get_minimum_interval_ms Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer) As Long


Declare PtrSafe Function usb_tc08_get_formatted_info Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer, ByVal unit_info As String, ByVal string_length As Integer) As Integer


Declare PtrSafe Function usb_tc08_get_unit_info2 Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer, ByVal unit_info As String, ByVal string_length As Integer, ByVal line As Integer) As Integer


Declare PtrSafe Function usb_tc08_get_last_error Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer) As Integer




'====================================================================
' Legacy API Calls


' Provided to aid backwards compatibility with code written
' for old TC08 Units (differences exist).


' These functions should not be used in new code and are
' deprecated for removal in a future version of the driver.
'=====================================================================


Declare PtrSafe Function usb_tc08_legacy_run Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer) As Integer


Declare PtrSafe Function usb_tc08_legacy_set_channel Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer, ByVal channel As Integer, ByVal tc_type As Integer, ByVal filter_factor As Integer, ByVal offset As Integer, ByVal slope As Integer)


Declare PtrSafe Function usb_tc08_legacy_get_temp Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer, ByRef temp As Long, ByVal channel As Integer, ByVal filtered As Integer) As Integer


Declare PtrSafe Function usb_tc08_legacy_get_cold_junction Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer, ByRef temp As Long) As Integer

Declare PtrSafe Function usb_tc08_legacy_get_driver_version Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" () As Integer


Declare PtrSafe Function usb_tc08_legacy_get_version Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer, ByRef version As Integer) As Integer


Declare PtrSafe Function usb_tc08_legacy_get_cycle Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByRef cycle As Long, ByVal handle As Integer) As Integer












Dim tc08_handle As Integer
Dim in_timer As Integer
Dim info As String * 80


Sub Close_Click()
If (tc08_handle > 0) Then
usb_tc08_close_unit (tc08_handle)
tc08_handle = -1
Cells(14, "E").value = "TC-08 closed"
End If
End Sub




Sub Open_Click()
Dim ok As Integer


If (tc08_handle < 1) Then
Cells(14, "E").value = "Opening TC-08"
tc08_handle = usb_tc08_open_unit()
If (tc08_handle > 0) Then
Cells(14, "E").value = "TC-08 opened"


Cells(9, "A").value = "Driver Version"
Call usb_tc08_get_unit_info2(tc08_handle, info, 80, 0)
Cells(9, "B").value = info

Cells(10, "A").value = "Kernel Driver Version"
Call usb_tc08_get_unit_info2(tc08_handle, info, 80, 1)
Cells(10, "B").value = info

Cells(11, "A").value = "Serial Number"
Call usb_tc08_get_unit_info2(tc08_handle, info, 80, 4)
Cells(11, "B").value = info

Cells(12, "A").value = "Cal Date"
Call usb_tc08_get_unit_info2(tc08_handle, info, 80, 5)
Cells(12, "B").value = info

Call usb_tc08_set_mains(tc08_handle, True)
ok = usb_tc08_set_channel(tc08_handle, 0, Asc("T"))
ok = usb_tc08_set_channel(tc08_handle, 1, Asc("T"))
ok = usb_tc08_set_channel(tc08_handle, 2, Asc("T"))
ok = usb_tc08_set_channel(tc08_handle, 3, Asc("T"))
Call Timer1_Timer
Else
If (tc08_handle = 0) Then
Cells(14, "E").value = "Unable to open TC-08"
Else
Cells(14, "E").value = "Error Code: " & usb_tc08_get_last_error(0)
End If
End If
End If



End Sub




Private Sub Timer1_Timer()
ReDim temp_buffer(9) As Single
Dim overflow_flag As Integer


If (tc08_handle > 0) Then
If (Not in_timer) Then
in_timer = True

ok = usb_tc08_get_single(tc08_handle, temp_buffer(0), overflow_flag, 0)

If (ok) Then
Cells(4, "A").value = temp_buffer(0)
Cells(4, "B").value = temp_buffer(1)
Cells(4, "C").value = temp_buffer(2)
Cells(4, "D").value = temp_buffer(3)
End If
in_timer = False
End If
End If
If tc08_handle > 0 Then Application.OnTime Now + TimeValue("00:00:05"), "Timer1_Timer"

End Sub




Here is also a screenshot of the spreadsheet.

18611

Thanks for any help I will receive:bow:

mdmackillop
03-12-2017, 02:47 PM
Two ways to try

Timed loop

Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:00:01"), "Record_Time"
End Sub

Sub Record_Time()
Dim tgt As Range
Set tgt = Sheets(2).Cells(Rows.Count, 1).End(xlUp)(2)
Sheets(1).Cells(1, 1).Copy tgt
tgt.Offset(, 1) = Now()
Application.OnTime Now + TimeValue("00:00:01"), "Record_Time"
End Sub



Change event

Private Sub Worksheet_Change(ByVal Target As Range)
Record_Time_2
End Sub

Sub Record_Time_2()
Dim tgt As Range
Set tgt = Sheets(2).Cells(Rows.Count, 1).End(xlUp)(2)
Sheets(1).Cells(1, 1).Copy tgt
tgt.Offset(, 1) = Now()
End Sub

mdmackillop
03-12-2017, 03:02 PM
Third option; modify your existing code


If (ok) Then
'Cells(4, "A").Value = temp_buffer(0)
'Cells(4, "B").Value = temp_buffer(1)
'Cells(4, "C").Value = temp_buffer(2)
'Cells(4, "D").Value = temp_buffer(3)

Set tgt = Sheets(2).Cells(Rows.Count, 1).End(xlUp)(2)
For i = 0 To 3
tgt.Offset(, i) = temp_buffer(i)
Next i
tgt.Offset(, 4) = Now()

End If

ahs_89
03-13-2017, 04:02 AM
Thank you mdmackkillop.

I used the third solution you proposed. In fact I used the same code before but I didn't now how to paste to a next row every time. It was the Row.count that I was missing.

Thank you another time :bow: