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
| Sub activePack()
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 "NOM DU LOGICIEL DE MA SOCIETE ICI"
attendre 0.6
Sheets("RECUP").Select
'POSITIONNEZ-VOUS SUR LE MENU SIMPLIFIE HANGAR SOUHAITE
For i = 4 To 4
attendre 0.5
SendKeys Range("j4").Value & Chr(13), True
attendre 0.6
Next
For i = 5 To 5
attendre 0.5
SendKeys Range("j5").Value & Chr(13), True
attendre 0.6
Next
For i = 6 To 6
attendre 0.5
SendKeys Cells(i, 10).Value, True
attendre 0.6
Next
For i = 7 To 7
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
' 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
SendKeys Cells(i, 10).Value, True
attendre 0.5
SendKeys "~"
attendre 0.7
Next
SendKeys "+{F3}"
attendre 0.7
For i = 46 To 53
SendKeys Cells(i, 10).Value, True
attendre 0.5
SendKeys "~"
attendre 0.7
Next
SendKeys "+{F6}"
attendre 0.7
For i = 54 To 54
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 |
Partager