K8055 + cellule TOR +excel

**charlesprogelec** · 11/05/2012, 14h35

Bonjour,
Je vais vous expliquez mon idée je veux installe 1 capteur TOR branché sur un relay puis au K8055 relié en USB à mon PC( avec excel et vb 2010).
Ainsi chaque fois que mon capteur detectera quelque chose ma digital input 1 sera à 1. De plus je souhaite recuperer mes données date et heure de chaque detection sur excel pour pouvoir tracer des graphes avec excel. J'ai comme vous l'avez vu ,j'ai mis un while 1 dans l'idée que lorsque je lance mon apllication exe elle tourne en continue de plus je fais un test pour voir si l'on change de jour car si on change de jour je crée un nouveau fichier.J'ai aussi mis une sauvegarde automatique tout les 100 flacons. Le probleme c'est que quand je compile

je vois

Erreur 1004 définie par l'application ou par l'objet

J'espère que vous pourriez me donner quelque piste pour m'aider à faire marcher ce programme. MERCI D AVANCE

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
 
 
'Je lance le programme au démarrage
'Lancer un programme au démarrage du PC -> Sans toucher au registre( menu Démarrer )
 
'Option Explicit
 
 
Private Declare Function OpenDevice Lib "K8055d.dll" (ByVal CardAddress As Long) As Long
Private Declare Sub CloseDevice Lib "K8055d.dll" ()
Private Declare Function SetCurrentDevice Lib "K8055d.dll" (ByVal CardAddress As Integer) As Integer
Private Declare Function SetTimer Lib "user32.DLL" ( _
ByVal HWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long)
Private Declare Function KillTimer Lib "user32.DLL" ( _
ByVal HWnd As Long, ByVal nIDEvent As Long)
Private Declare Function ReadAllDigital Lib "K8055d.dll" () As Long
Private Declare Function ReadDigitalChannel Lib "K8055d.dll" (ByVal Channel As Long) As Boolean
Private Declare Sub SetAllDigital Lib "K8055d.dll" ()
Private Declare Function WriteAllDigital Lib "K8055d.dll" (ByVal Data 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)
 
 
 
 
        '////////////////////////////Initialisation des variables/////////////////////////////
 
 
Dim Channel(8) As String
Dim TimerID As Long
Dim TimerSeconds As Single
Dim Connected As Boolean
 
 
 
 Dim Byt As Boolean
 
 Dim Date_jour As String
 Dim heure_detection As String
 ' Dim Date_jour As Date
 ' Dim heure As Date
 
 
Dim nb_flacon As Integer
Dim N As Long
Dim D As String
 'variable connexion à la carte
Dim CardAddress As Long
Dim h As Long
 
 
 
            '////////////////////////////////////LES FONCTIONS////////////////////////////////
 
 
'Fonction derniere ligne
 
Sub Derniereligne(N As Long)
Static Derniere_ligne As Long
 
Derniere_ligne = ActiveSheet.Columns.End(xlDown).Row
 
 
N = Derniere_ligne + 1
End Sub
 
 
 
 
' Function Entier
 
'Function Entier(Nombre) As Boolean
'Entier = Int(Nombre) = Nombre
'End Function
 
 
'Fonction dernier fichier du repertoire
 
Function DernierFichier(Chemin As String)
Dim fichier As String, DerniereDate As Date
fichier = Dir(Chemin)
Do While fichier <> ""
    If FileDateTime(Chemin & fichier) > DerniereDate Then
        DerniereDate = FileDateTime(Chemin & fichier)
        DernierFichier = fichier
    End If
    fichier = Dir()
Loop
End Function
 
Sub OuvrirDernierDoc()
Dim Chemin As String
 
Chemin = "K:\reactif\Charles\FICHIER PROD\"
 
ChangeFileOpenDirectory = Chemin
Workbooks.Open (Chemin & DernierFichier(Chemin))
End Sub
 
 
 
 
'////////////////////////////////////PROGRAMME PRINCIPALE//////////////////////////////////
 
 
 
 
 
Private Sub Workbook_Open()
 
 
 
Call OuvrirDernierDoc 'call de la fonction dernier doc  (avant le while 1)
 
 
 
        '//////connexion à la carte//////
CardAddress = 0 'j utilise 1 seul VM110
h = OpenDevice(CardAddress)
Select Case h
  Case 0, 1, 2, 3
   ActiveSheet.Cells(1, 4).Value = "card" + Str(h) + " connected"
  Case -1
  ActiveSheet.Cells(2, 4).Value = "card" + Str(CardAddress) + " no found"
 
End Select
 
 
 
        '//Boucle infinie//
        While 1
 
 
 
 
 
Date_jour = Format(Now, "yyyy-mm-dd") 'je recupere que jour/moi/année
 
'je definie date jour avant de fair le test
 
 
'///////////////////////////// TEST CHANGEMENT DE JOUR ///////////////////////////////////
 
If Date_jour = ActiveSheet.Cells(1, 5).Value Then
 
 
 
 
'///////////////////////////// DEFINITON DES COLONNES ///////////////////////////////////
    'On nomme les colonnes
 
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Nombre de Flacon"
    Range("A2").Select
    Columns("A:A").ColumnWidth = 16.71
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Heure"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Date"
    Range("C2").Select
 
 
'///////////////////////////// LES VARIABLES   ///////////////////////////////////
 
 
 
nb_flacon = Cells(3, 4)
 
Byt = ReadDigitalChannel(1)
 
'///////////////////////////// Remplissage du tableau ///////////////////////////////////
 
' Remplir 3 colonnes : une disant le nombre de flacon et une les jours et l'autre les heures
 
 
 
    If (Byt = True) Then
' prévoir un anti rebond avec détection de front descendant
 
     nb_flacon = nb_flacon + 1 'j'increment maintenant car si nouveau tableau 0+1=1 et si recup d'un ancien excelje dois incrementer l'ancienne avleur avant de la copier
 
    Date_jour = Format(Now, "yyyy-mm-dd") 'je recupere que jour/moi/année
    heure_detection = Format(Now, "HH:m:ss.fff") 'je recupere que heure/min/sec
 
    Derniereligne (N)  'je prend ma dernier ligne au cas ou je reprend un ancien fichier
 
    ActiveWorkbook.ActiveSheet.Cells(N, 1).Value = nb_flacon
 
 
    ActiveWorkbook.ActiveSheet.Cells(N, 2).Value = heure_detection
 
 
    ActiveWorkbook.ActiveSheet.Cells(N, 3).Value = Date_jour
 
 
'j'incremente mon nombre de flacon
 
 
ActiveWorkbook.ActiveSheet.Cells(3, 4).Value = nb_flacon 'apres l'incrementation je recopie la valeur de nb_flacon
 
ActiveWorkbook.ActiveSheet.Cells(1, 5).Value = Date_jour 'j'ecris la date sur la case (1,5)
 
'///////////////// Function sauvegarder ///////////////////////////////////////
Dim Save As Double
 
 
        Save = nb_flacon / 100
        'sauvegarde tout les 100 flacons en testant si la valeur divisé par 100 est un entier
 
 
        If CInt(Save) = Save Then
        ActiveWorkbook.Save
        End If
 
 
    End If
 
 
Else
 
 
'///////////////////////////// CHANGEMENT DE JOUR ///////////////////////////////////
 
                  'creer nouveau classeur si nouvelle journee
 
 
 
 
D = Day(Now) & "_" & Month(Now) & "_" & Year(Now) & "_" & Hour(Now) & "_" & Minute(Now)
Workbooks.Add
 
 
ChDir "N:\Charles\FICHIER PROD"
    ActiveWorkbook.SaveAs Filename:="N:\Charles\FICHIER PROD\Production flacon du_" & D & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
 
 
 
End If
Wend
End Sub

**Daranc** · 11/05/2012, 14h43

et le debug ne te donnes pas une ligne de code ou ça c'est arrêté ?

**charlesprogelec** · 11/05/2012, 16h10

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
Do While fichier <> ""
    If FileDateTime(Chemin & fichier) > DerniereDate Then
        DerniereDate = FileDateTime(Chemin & fichier)
        DernierFichier = fichier
    End If
    fichier = Dir()
Loop

ben ça reste dans la boucle loop de la recherche du fichier le plus recent ça fait 9 fois la boucle puis sa lance le chargement et je vois le mesg d'erreur
sachant que j'ai deja testé cette partie du programme dans un autre fichier excel et que ça marche oO

**Daranc** · 11/05/2012, 18h22

et faire une liste des fichiers?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Liste_des_Dossiers()
If Cells(1, 256).Value = 0 Then Exit Sub
Dim fs, f, f1, fc, s
Dim tablo() As Variant
s = 1
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder("\\Serveur\repertoir\dossier\sous_dossier")
Set fc = f.SubFolders
For Each f1 In fc
ReDim Preserve tablo(1 To s)
tablo(s) = f1.Name
s = s + 1
Next

après tu cherche dans les item du tableau celui qui t’intéresses par un boucle

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
for t=0 to ubound(tablo,1) 
 
'traitement du nom du fichier
 
next

l'avantage c'est que tu n'auras pas de boucle infinie

**charlesprogelec** · 14/05/2012, 10h29

oui mais moi je veux pas à avoir a désigner dans un tableau le fichier a ouvrir mon programme ouvre le dernier fichier est regarde la date et change de fichier si on a changé de jour en plus mon programme se lance avec l'ordi le but c'est qu'on est juste à allumer l'ordi est le K8055 et vb me completer mes feuilles excels l'erreur
sur l'image qui suit ça ouvre le fichier le plus recent et créé un nouveau fichier

l'erreur 1004...
http://cjoint.com/12mi/BEoj5N6pPsl.htm