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
| Option Explicit
Declare Function GetKeyState Lib "user32" ( _
ByVal nVirtKey As Long) As Integer
Dim stp As Boolean
Sub activation()
'On Error GoTo gestionerreur
Dim i As Integer, MemJ8 As Integer, Memj34 As String
If MsgBox("Assurez-vous que votre session n'est pas expirée", vbYesNo, "Demande de confirmation") = vbYes Then
stp = False
AppActivate "essai"
Sheets("RECUP").Select
End If
For i = 4 To 6
'***************************************
DoEvents
If stp = True Then Exit Sub
attendre 0.5
SendKeys Cells(i, 10).Value, True
SendKeys "~"
attendre 0.5
Next i
SendKeys "{ENTER}"
If stp = True Then Exit Sub
attendre 0.5
For i = 8 To 20
DoEvents
If stp = True Then Exit Sub
' Si I = 8 alor on mémorise la valeur de la cellule
If i = 8 Then
MemJ8 = Range("J8").Value
' Si I = 16 ou 17
If i = 17 Or i = 18 Then
If MemJ8 = 3 Then
attendre 0.5
SendKeys Cells(i, 10).Value, True
If stp = True Then Exit Sub
SendKeys "~"
If stp = True Then Exit Sub
attendre 0.5
End If
Else
' Si I à une autre valeur que 16 ou 17
SendKeys Cells(i, 10).Value, True
If stp = True Then Exit Sub
SendKeys "~"
attendre 0.6
End If
For i = 21 To 38
DoEvents
If stp = True Then Exit Sub
' si la valeur dans J34 est autre que BF, on fait ENTER
If i = 34 Then
Memj34 = Range("J34").Value
SendKeys Cells(i, 10).Value, True
attendre 0.5
If Memj34 <> "BF" Then
SendKeys Cells(i, 10).Value, True
SendKeys "{ENTER 1}"
If stp = True Then Exit Sub
SendKeys "~"
If stp = True Then Exit Sub
attendre 0.6
Else
'Acion si = BF
End If
Else
SendKeys Cells(i, 10).Value, True
attendre 0.5
If stp = True Then Exit Sub
SendKeys "~"
If stp = True Then Exit Sub
attendre 0.6
End If
Next i
For i = 39 To 39
DoEvents
If stp = True Then Exit Sub
SendKeys Cells(i, 10).Value, True
If stp = True Then Exit Sub
attendre 0.5
Next i
SendKeys "{ENTER 2}"
If stp = True Then Exit Sub
attendre 0.55
For i = 41 To 45
DoEvents
If stp = True Then Exit Sub
attendre 0.5
SendKeys Cells(i, 10).Value, True
SendKeys "~"
If stp = True Then Exit Sub
attendre 0.55
Next i
SendKeys "+{F3}"
If stp = True Then Exit Sub
attendre 0.7
For i = 46 To 53
DoEvents
If stp = True Then Exit Sub
SendKeys Cells(i, 10).Value, True
If stp = True Then Exit Sub
attendre 0.5
SendKeys "~"
If stp = True Then Exit Sub
attendre 0.55
Next i
SendKeys "+{F6}"
If stp = True Then Exit Sub
attendre 0.6
For i = 54 To 54
DoEvents
If stp = True Then Exit Sub
SendKeys Cells(i, 10).Value, True
If stp = True Then Exit Sub
attendre 0.6
SendKeys "~"
attendre 0.55
Sheets("DONNE").Select
Range("E4").Select
Exit Sub
gestionerreur:
MsgBox "fichier non ouvert ou réduit dans la barre des tâches : abandon"
End Sub
Sub attendre(sec%)
Dim deb&, fin&
deb = Timer
fin = deb + sec%
Do Until Timer >= fin
DoEvents
If GetKeyState(27) > 0 Then
'If MsgBox("Confirmation arrêt macro", vbOKCancel + vbQuestion) = vbOK Then
'SendKeys Chr(27)
stp = True
Exit Sub
'End If
SendKeys Chr(27)
End If
Loop
End Sub |
