Sub Récupérer(ByVal NomFic As String, ByVal Plage As Range, _
Optional ByVal CelHeure As Range, Optional ByVal Abandonner As Boolean = True)
Rem. ——— Récupérer dans une plage le contenu d'un fichier texte fabriqué
' par la procédure Distribuer du classeur central.
' NomFic: Le nom du fichier à récupérer, sans l'extension ".txt".
' Plage: La plage devant recevoir le contenu du fichier.
' CelHeure: Cellule contenant la date et l'heure de modification du fichier de même nom
' qui avait été récupéré pour la dernière fois. Si l'heure du fichier existant est
' toujours la même, la récupération n'a pas lieu. Sinon la cellule est corrigée.
' Facultatif. Si non précisée la procédure est toujours exécutée.
' Abandonner: Option facultative, sans objet si CelHeure n'est pas spécifiée.
' True ou omis —> Si la date n'a pas changé, la récupération n'a pas lieu.
' Spécifié à False —> La procédure garde la main jusqu'à ce qu'elle change (dans
' certaines limites).
Dim Chemin As String, DatHMàJ As Date, DatHFic As Date, DatHMsg As Date, _
Te() As String, Ts(), Ls As Long, Z As String, C As Long, Rép As VbMsgBoxResult
CheminChemin = ThisWorkbook.Path & "\Communication"
ChDrive Chemin
On Error Resume Next: ChDir Chemin
If Err Then MkDir Chemin: ChDir Chemin
On Error GoTo 0
If Not CelHeure Is Nothing Then
DatHMàJ = CelHeure.Value
DatHMsg = Now + TimeSerial(0, 0, 10)
Do: DatHFic = FileDateTime(NomFic & ".txt")
If DatHFic > DatHMàJ Then Exit Do
If Abandonner Then Exit Sub
If Now > DatHMsg Then
If Rép = vbIgnore Then Exit Sub
Rép = MsgBox("La réponse du classeur central tarde…" & vbLf _
& "Si vous réessayez, à dans 20 secondes !", _
vbAbortRetryIgnore + vbInformation, "Communication")
If Rép = vbAbort Then Exit Sub
DatHMsg = Now + TimeSerial(0, 0, 20): End If
DoEvents: Loop
CelHeure.Value = DatHFic: End If
ReDim Ts(1 To 50000, 1 To 100)
Open NomFic & ".txt" For Input Access Read As #1
While Not EOF(1)
Line Input #1, Z: Te = Split(Z, vbTab)
If UBound(Te) + 1 > UBound(Ts, 2) Then ReDim Preserve Ts(1 To 50000, 1 To UBound(Te) + 1)
Ls = Ls + 1
For C = 0 To UBound(Te)
If Left$(Te(C), 1) = """" Then
Ts(Ls, C + 1) = Replace$(Mid$(Te(C), 2, Len(Te(C)) - 2), """""", """")
ElseIf IsNumeric(Te(C)) Then
Ts(Ls, C + 1) = CDbl(Te(C))
End If: Next C: Wend
Close #1
Application.EnableEvents = False
Plage.ClearContents
Plage.Resize(Ls, UBound(Ts, 2)).Value = Ts
Application.EnableEvents = True
End Sub