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
|
Function Extraction(ChaineSource As String, Optional LimiteAvant As String = "", Optional LimiteApres As String = "")
'par: Excel-Malin.com ( http://excel-malin.com )
On Error GoTo FunctionErreur
If InStr(1, ChaineSource, LimiteAvant) = 0 Then
Extraction = CVErr(xlErrNA)
Exit Function
Else
ExtraitPositionDebut = InStr(1, ChaineSource, LimiteAvant) + Len(LimiteAvant)
End If
If LimiteApres = "" Then
ExtraitPositionFin = Len(ChaineSource)
Else
ExtraitPositionFin = InStr(1, ChaineSource, LimiteApres) - 1
End If
Extraction = Mid(ChaineSource, ExtraitPositionDebut, ExtraitPositionFin - ExtraitPositionDebut + 1)
Exit Function
FunctionErreur:
Extraction = CVErr(xlErrNA)
'Extraction = ""
End Function
Public Function Triage()
'par: http://excel-malin.com
On Error GoTo FonctionErreur
Dim j As Integer
Dim i As Integer
Dim PremiereFeuille As Integer
Dim DerniereFeuille As Integer
PremiereFeuille = 1
DerniereFeuille = ActiveWorkbook.Worksheets.Count
For i = PremiereFeuille To DerniereFeuille
For j = i To DerniereFeuille
If OrdreDescendant = True Then
If UCase(Worksheets(j).Name) > UCase(Worksheets(i).Name) Then
Worksheets(j).Move Before:=Worksheets(i)
End If
Else
If UCase(Worksheets(j).Name) < UCase(Worksheets(i).Name) Then
Worksheets(j).Move Before:=Worksheets(i)
End If
End If
Next j
Next i
Exit Function
FonctionErreur:
End Function
Sub Numerotation()
''Désactive les evénements de la feuille
''Sinon à chaque mise à jour de cellule la macro se lance
Dim heure As Date
Dim flash As String
Dim chrono As String
Dim serie As String
Dim existant As Boolean
Dim n As Integer
Dim lieu As String
Dim qui As String
Application.EnableEvents = False
flash = "Entreprise Serial Number: GCJVKPA AssetNumber: ESTS0144"
Exist = False
''Extraction est une fonction copiée d'internet
chrono = Extraction(flash, "AssetNumber: ", "")
serie = Extraction(flash, "Serial Number: ", "Asset")
serie = Replace(serie, " ", "")
Sheets("AMouvements").Cells(1, 1) = chrono
Sheets("AMouvements").Cells(1, 2) = serie
''Collage de l'heure et insertion de ligne
Sheets("AMouvements").Cells(1, 3) = Now
Sheets("AMouvements").Range("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
''Test si une page pour cette tablette existe
For n = 1 To Sheets.Count
If Application.Sheets(n).Name = chrono Then existant = True: Exit For
Next n
''Création de la page si elle n'existe pas, Triage est une fonction récupérée d'internet
If existant = False Then
Sheets.Add: ActiveSheet.Name = chrono: Triage
End If
Sheets(chrono).Select
''Remplissage de la page
Cells(1, 1) = Now
'Cells(1, 2) = lieu
'Cells(1, 3) = qui
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Range("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("AMouvements").Select
''Réactivition des evenements puis tempo de 2 minutes pour déconnexion et réinitalisation du lieu et du qui
''Réactivation des evenements avant pour pouvoir couper la tempo si flash avant la fin
''Pas d'utilisation de application.wait car ça bloque excel
Application.EnableEvents = True
heure = Now + TimeValue("00:00:10")
'' C'EST ICI QUE JE SOUHAITERAIS METTRE LA TEMPORISATION
End Sub
Sub Attente_et_fermeture()
MsgBox ("fin")
'qui = ""
'lieu = ""
'Application.ThisWorkbook.Save
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Call Numerotation
End Sub |
elwinner08 
Insertion d'une pause non bloquante dans une macro
Répondre avec citation
Envoyé par mfoxy
Partager