I want to graphically display the time between electrical contacts making and breaking using MS Excel. Does anyone know whether this can be programmed in VBA or do I need to install the full version of visual basic. Without the full visual basic installed I can’t even open the example files. I just need help to get the input into a variable in VBA and can take it from there.
Thanks
Peter
Do you need to get the variable automatically and periodically updated or can you do the update manually?
If automatically, then you can use the timer functions provided by the Windows API library.
Here is an example code using the timer: cpearson.com/excel/ontime.htm
Just add the K8055 input function to the Sub TimerProc.
Put the K8055’s startup code to some other procedure that you execute first.
Here is a VBA procedure that reads the digital inputs of the K8055 card and displays the value on Excel sheet. The state is displayed in decimal and in binary form.
Add two buttons ‘Start’ and ‘Stop’ on the sheet. Assign the macros Start_Click and Stop_Click to these buttons.
Type the card address to cell C1 and press Enter before you click the Start button.
The update interval in this example is 1 sec.
Put the K8055D.DLL to Windows’ SYSTEM32 folder.
[code]Private Declare Function SetTimer Lib “user32” ( _
ByVal HWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib “user32” ( _
ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function OpenDevice Lib “k8055d.dll” (ByVal CardAddress As Long) As Long
Private Declare Function ReadAllDigital Lib “k8055d.dll” () As Long
Dim TimerID As Long
Dim TimerSeconds As Single
Dim Connected As Boolean
Sub StartTimer()
TimerSeconds = 1 ’ how often to “pop” the timer.
TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
End Sub
Sub EndTimer()
On Error Resume Next
KillTimer 0&, TimerID
End Sub
Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _
ByVal nIDEvent As Long, ByVal dwTimer As Long)
Dim Byt As Long
Dim Bit As Long
On Error Resume Next
’
’ The procedure is called by Windows. Put your
’ timer-related code here.
’
Byt = ReadAllDigital
ActiveSheet.Cells(3, 1).Value = Byt
For i = 0 To 4
If (Byt And 2 ^ i) Then Bit = 1 Else Bit = 0
ActiveSheet.Cells(4, 5 - i).Value = Bit
Next i
’
End Sub
Sub Start_Click()
Dim CardAddress As Long
Dim h As Long
CardAddress = ActiveSheet.Cells(1, 3).Value
h = OpenDevice(CardAddress)
Select Case h
Case 0, 1, 2, 3
ActiveSheet.Cells(1, 1) = “Card " + Str(h) + " connected”
Case -1
ActiveSheet.Cells(1, 1) = “Card " + Str(CardAddress) + " not found”
End Select
StartTimer
End Sub
Sub Stop_Click()
EndTimer
ActiveSheet.Cells(1, 1) = “Stopped”
End Sub[/code]
Thanks for your help. Sorry for the delay in responding.
I can’t get your procedure to work - it hangs on “AddressOf TimerProc”. I have looked up settimer but it is complex and beyond my programming skills.
I am attempting to build a tachometer measuring up to 6000 rpm. It appears that the timegettime procedure will measure time down to 1Ms and is simple to call.
The code I have used is as follows:
Private Declare Function timeGetTime Lib “winmm.dll” () As Long
Private Declare Function timeBeginPeriod Lib “winmm.dll” (ByVal uPeriod As Long) As Long
'16-bit programs must use MMSYSTEM.DLL instead of WINMM.DLL
Private Declare Sub Sleep Lib “kernel32” (ByVal uDuration As Long)
'16-bit programs cannot do a “Sleep”, just omit it in that case
Private Sub CommandButton1_Click()
'Initialise variables
Previouscontactsmade = 0
i = 0
j = 0
stoppressed = False
Sheet1.Cells(1, 1) = “Interval”
timeBeginPeriod 1 'switch resolution to 1 ms
Do While stoppressed = False 'Test until command button 2 is pressed to set stoppressed = true
Do Until channel1 = True 'Loop until Channel 1 input is true
channel1 = ReadDigitalChannel(1)
DoEvents 'allows operating system to process other commands
Loop
i = i + 1
contactsmade = timeGetTime 'record time contacts make
If Previouscontactsmade <> 0 Then
Sheet1.Cells(i, 1) = contactsmade - Previouscontactsmade
End If
Do Until channel1 = False 'Loop until contacts break
channel1 = ReadDigitalChannel(1)
Loop
Previouscontactsmade = contactsmade
DoEvents 'allows operating system to process stop command
Loop
End Sub
Private Sub CommandButton2_Click()
stoppressed = True
MsgBox (“Stop pressed”)
End Sub
I am having trouble getting a reliable make and break signal on the digital input. Do you know at what speed the board can read voltage changes? I am also considering using a phototransistor or the velleman infra red alarm to make and break the contacts optically.
The PC can send requests and get response from the K8055 card every 10mS. In the manual is said that “General conversion time is 20mS per command”. This is due to the USB polling interval of 10mS.
I can’t test your code because there are missing some sections e.g. K8055D.DLL function declarations and the OpenDevice function.
Anyhow I understand how your code is meant to work.
One alternative could be to use the counter of the K8055 card. You may count the pulses from your tachometer and display the result on the Excel sheet.
This may be due to that you have Excel 97 or earlier. The AddressOf function works only in the Office 2000 or later.
I only included the main body of the code. The declarations etc are elsewhere. I am using excel 2000 on windows XP.
Am I right in thinking that inputs 1 and 2 can count at 2000 cycles per second but can only pass the results to the computer every 20 Ms. Do you have a device that can poll faster?
Thanks
Sorry but 20 ms is the highest polling rate of the low speed USB that this PIC microcontroller is made for.
Strange that the macro didn’t run under your Excel 2000.
Here is my other test code that reads the counter of the K8055 and displays the count in RPM on Excel sheet. The update rate is 3 sec to get higher resolution.
[code]Private Declare Function SetTimer Lib “user32” ( _
ByVal HWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib “user32” ( _
ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function OpenDevice Lib “k8055d.dll” (ByVal CardAddress As Long) As Long
Private Declare Function ReadCounter Lib “k8055d.dll” (ByVal CounterNr As Long) As Long
Private Declare Sub ResetCounter Lib “k8055d.dll” (ByVal CounterNr As Long)
Private Declare Sub SetCounterDebounceTime Lib “k8055d.dll” (ByVal CounterNr As Long, ByVal DebounceTime As Long)
Dim NewCount As Long
Dim OldCount As Long
Dim h As Long
Dim TimerID As Long
Dim TimerSeconds As Single
Dim Connected As Boolean
Sub StartTimer()
TimerSeconds = 3 ’ the timer interval is now 3 sec.
TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
End Sub
Sub EndTimer()
On Error Resume Next
KillTimer 0&, TimerID
End Sub
Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, ByVal nIDEvent As Long, ByVal dwTimer As Long)
On Error Resume Next
NewCount = ReadCounter(1)
If NewCount > OldCount Then
Sheet1.Cells(3, 1).Value = (NewCount - OldCount) * 20 ’ displays the RPM value
End If
OldCount = NewCount
End Sub
Sub Start_Click()
If Not Connected Then
h = OpenDevice(Sheet1.Cells(1, 3).Value)
Select Case h
Case 0, 1, 2, 3
Sheet1.Cells(1, 1) = “Card connected”
Connected = True
Case -1
Sheet1.Cells(1, 1) = “Card not found”
End Select
End If
If Connected Then
ResetCounter 1
SetCounterDebounceTime 1, 0 ’ select different debounce time if needed (now 0 ms)
StartTimer
Sheet1.Cells(2, 1) = “Running”
End If
End Sub
Sub Stop_Click()
EndTimer
Sheet1.Cells(2, 1) = “Stopped”
End Sub[/code]
Thanks for the code. Unfortunately it still hangs on the starttimer procedure at “AddressOf TimerProc” with the message " Invalid use of Addressof operator". I can’t resolve this.
Have you managed to run this on Excel 2000 VBA?
I’m using Excel 2002. The information that the Excel 2000 supports AddressOf function is based on several sources from the net e.g.:
awprofessional.com/articles/ … Num=5&rl=1
“Excel 2000 added a VBA function called AddressOf, which provides the address in memory where a given procedure can be found. This address is passed to the API function, which calls back to the procedure found at that address as required.”
cpearson.com/excel/ontime.htm
“These procedures require that you are using Office 2000 or later, because we use the AddressOf function. They will not work in Excel 97 or earlier.”
Strange indeed that it doesn’t work in your Excel 2000.
The error indicates invalid use of the adressof operator, it doesn’t say the operator does not exist. Maybe the syntax of the operator differens between the two versions?
Something i found in the documentation:
Thanks anyway. I have the code to complete the experiment so I will work with that.
Many thanks for your time.
Bonjour,
J’essaie de programmer une petite application en VBA via le support Excel
mais pas possible d’ajouter la référence.
Comment faire ?
merci
Could you please describe your problem more detailed.
Please put your code here.
[quote=“VEL255”]Could you please describe your problem more detailed.
Please put your code here.[/quote]
Bj,
voici le message d’erreur obtenue
Sub, Function ou Property non définie (erreur 35)
La DLL est bien copiée dans le system32 de window
See: support.microsoft.com/kb/142138
Sub or function not defined (Error 35)
A Sub, Function, or Property procedure is called but is not defined.
Possible causes for this error are:
• You have misspelled the name of your procedure.
• The specified procedure is not visible to the calling procedure. Procedures declared Private in one module can’t be called from procedures outside the module. If Option Private Module is in effect, procedures in the module are not available to other projects. Choose Find from the Edit menu to locate the procedure.
• You have declared a dynamic-link library (DLL) routine, but the routine is not in the specified library.
Bonjour,
J’utilise le code ci dessous pour lire les entrées digital de la carte
De l’exemple plus haut dans le topic (TBon)
Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _
ByVal nIDEvent As Long, ByVal dwTimer As Long)
Dim Byt As Long
Dim Bit As Long
On Error Resume Next
’
’ The procedure is called by Windows. Put your
’ timer-related code here.
’
Byt = ReadAllDigital
ActiveSheet.Cells(3, 1).Value = Byt
For i = 0 To 4
If (Byt And 2 ^ i) Then Bit = 1 Else Bit = 0
ActiveSheet.Cells(4, 5 - i).Value = Bit
Next i
’
End Sub
La procédure pour écrire les sorties digitals , est-elle la même ?
mon petite programme que j’essaie :
lire une entrée digital
et suivant plussieurs conditions, activation de la sortie correspondante.
Pourriez -vous me mettre sur la voie, pour établir la petite macro ??
merci de votre attention.
If I understand right that you what to output the same bits as you input, then:
Just add to the declarations section:
Private Declare Function WriteAllDigital Lib "k8055d.dll" (ByVal Data As Long) As Long… and change the code to:
Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _
ByVal nIDEvent As Long, ByVal dwTimer As Long)
Dim Byt As Long
Dim Bit As Long
On Error Resume Next
'
' The procedure is called by Windows. Put your
' timer-related code here.
'
Byt = ReadAllDigital
WriteAllDigital Byt
ActiveSheet.Cells(3, 1).Value = Byt
For i = 0 To 4
If (Byt And 2 ^ i) Then Bit = 1 Else Bit = 0
ActiveSheet.Cells(4, 5 - i).Value = Bit
Next i
End Sub
Bonjour,
Le code fonctionne parfaitement avec l’exemple
Sur la carte, il me reste 3 sorties digitals, comment adapté le code pour activer les sorties 6 à 8 soit individuellement ou sur conditions ?
merci de votre attention
Now input I5 (and button Inp5) acts as a selector. When I5 is pulled down (or button Inp5 pressed) then the inputs I1 to I4 are controlling the outputs O5 to O8.
Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _
ByVal nIDEvent As Long, ByVal dwTimer As Long)
Dim Byt As Long
Dim Tmp As Long
Dim Bit As Long
On Error Resume Next
'
' The procedure is called by Windows. Put your
' timer-related code here.
'
Byt = ReadAllDigital
Tmp = (Byt And &HF)
If (Byt And &H10) Then Tmp = Tmp * 16
WriteAllDigital Tmp
ActiveSheet.Cells(3, 1).Value = Tmp
For i = 0 To 7
If (Tmp And 2 ^ i) Then Bit = 1 Else Bit = 0
ActiveSheet.Cells(4, 8 - i).Value = Bit
Next i
End Sub
Bonjour,
Le code est parfait pour visualiser les entrées et sortie sur une feuille Excel.
Comment faire pour intéger (visualisation) dans un Userform
par Ex :
Une entrée sur checkBox ou textBox
Avec l’exemple ci dessous:
Private Declare Function SetTimer Lib “user32” ( _
ByVal hWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib “user32” ( _
ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function OpenDevice Lib “k8055d.dll” (ByVal CardAddress As Long) As Long
Private Declare Sub CloseDevice Lib “k8055d.dll” ()
Private Declare Function WriteAllDigital Lib “k8055d.dll” (ByVal Data As Long) As Long
Private Declare Function ReadAllDigital Lib “k8055d.dll” () As Long
Private Declare Sub SetAllDigital Lib “k8055d.dll” ()
Dim TimerID As Long
Dim TimerSeconds As Single
Dim Connected As Boolean
Sub StartTimer()
TimerSeconds = 1 ’ how often to “pop” the timer.
TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
End Sub
Sub EndTimer()
On Error Resume Next
KillTimer 0&, TimerID
End Sub
Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal nIDEvent As Long, ByVal dwTimer As Long)
Dim Byt As Long
Dim Bit As Long
On Error Resume Next
’ The procedure is called by Windows. Put your timer-related code here.
Byt = ReadAllDigital
'ActiveSheet.Cells(3, 1).Value = Byt
For i = 0 To 4
If (Byt And 2 ^ i) Then Bit = 1 Else Bit = 0
ActiveSheet.Cells(5, 5 - i).Value = Bit
Next i
Dans un Userform , j’obteint message d’erreur compilation
merci de votre attention