Public stp As Boolean
Sub activePack()
MsgBox PressePapier, vbInformation, "tester le presse papier"
PressePapier = "Ce texte se trouve maintenant dans le presse papier"
Dim i As Integer, MemJ8 As Integer
'On Error GoTo gestionerreur
If MsgBox("Avant de confirmer la saisie automatique, assurez-vous que :" & Chr(10) & Chr(10) & "- Les observations du client issues de la vérification des informations ont été prises en compte," & Chr(10) & "- Vous êtes bien positionné sur le menu ouverture simplifié - Nouveau Client Pack ... .", vbYesNo, "Demande de confirmation") = vbYes Then
AppActivate "essai"
If PressePapier = "Stop" Then End
attendre 0.6
For i = 4 To 4
'***************************
DoEvents
If stp = True Then Exit Sub
If PressePapier = "Stop" Then End
'***************************
attendre 0.5
SendKeys Range("j4").Value & Chr(13), True
attendre 0.6
Next
For i = 5 To 5
'***************************
DoEvents
If stp = True Then Exit Sub
If PressePapier = "Stop" Then End
'***************************
attendre 0.5
SendKeys Range("j5").Value & Chr(13), True
attendre 0.6
Next
For i = 6 To 6
'***************************
DoEvents
If stp = True Then Exit Sub
If PressePapier = "Stop" Then End
'***************************
attendre 0.5
SendKeys Cells(i, 10).Value, True
attendre 0.6
Next
For i = 7 To 7
'***************************
DoEvents
If stp = True Then Exit Sub
If PressePapier = "Stop" Then End
'***************************
attendre 0.5
SendKeys "" & Chr(13), True
attendre 0.6
Next
SendKeys "N" & Chr(13), True
attendre 0.8
SendKeys "{LEFT}"
SendKeys "{ENTER}"
attendre 0.7
SendKeys "~"
attendre 0.8
For i = 8 To 25
'***************************
DoEvents
If stp = True Then Exit Sub
If PressePapier = "Stop" Then End
'***************************
' 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
' Si la veleur mémorisée est 3
If MemJ8 = 3 Then
' On inscrit le nom et le prénom du mari
SendKeys Cells(i, 10).Value, True
SendKeys "~"
attendre 0.7
End If
Else
' Si I à une autre valeur que 16 ou 17
SendKeys Cells(i, 10).Value, True
attendre 0.7
SendKeys "~"
attendre 0.6
End If
Next
For i = 26 To 45
'***************************
DoEvents
If stp = True Then Exit Sub
If PressePapier = "Stop" Then End
'***************************
SendKeys Cells(i, 10).Value, True
attendre 0.5
SendKeys "~"
attendre 0.7
Next
SendKeys "+{F3}"
attendre 0.7
For i = 46 To 53
'***************************
DoEvents
If stp = True Then Exit Sub
If PressePapier = "Stop" Then End
'***************************
SendKeys Cells(i, 10).Value, True
attendre 0.5
SendKeys "~"
attendre 0.7
Next
SendKeys "+{F6}"
attendre 0.7
For i = 54 To 54
'***************************
DoEvents
If stp = True Then Exit Sub
If PressePapier = "Stop" Then End
'***************************
SendKeys Cells(i, 10).Value, True
attendre 0.7
Next
Exit Sub
gestionerreur:
MsgBox "fichier non ouvert ou réduit dans la barre des tâches : abandon"
End If
End Sub
Sub attendre(sec%)
Dim deb%, fin%
deb% = Timer
fin = deb% + sec%
Do Until Timer >= fin%
DoEvents
Loop
End Sub