Chargement de fichiers
Bonjour le forum
Je n'y connais pas grand chose mais j'ai un soucis pour le versement des données.
En fait j'ai 4 fichiers qui actuellement sont remplacés si plus récents mais en fait je veux les télécharger systématiquement.
J'aurais besoin d'aide pour supprimer ce système de récent.
Merci à vous.
Option Explicit
Private VersementOK As Boolean
Public Sub Worksheet_Activate()
Dim Chemin As String, RngFic As Range, TFic(), C As Long, NomFic As String, DatFic As Date, _
NbRécents As Long, Rép As VbMsgBoxResult, WbkDon As Workbook
Chemin = Me.[CheminDonnées].Value
Set RngFic = Me.[TabFichiers]
TFic = RngFic.Value
For C = 2 To 5
NomFic = Dir(Chemin & RngFic(1, C).Value)
TFic(6, C) = Empty: TFic(5, C) = "(• Non trouvé •)"
While NomFic <> ""
DatFic = FileDateTime(Chemin & NomFic)
If TFic(6, C) < DatFic Then
TFic(6, C) = DatFic: TFic(5, C) = NomFic
End If
NomFic = Dir: Wend
If TFic(3, C) < TFic(6, C) Then NbRécents = NbRécents + 1
Next C
If NbRécents Then Rép = MsgBox(IIf(NbRécents > 1, NbRécents & " fichiers plus récents ont été trouvés." & vbLf _
& "Voulez vous les ", "Un fichier plus récent a été trouvé." & vbLf & "Voulez vous l'") & "importer ?", _
vbYesNo, "Vérification dates fichiers") Else Rép = vbNo
If Rép = vbYes Then
For C = 2 To 5
If TFic(3, C) < TFic(6, C) Then
Set WbkDon = Workbooks.Open(Chemin & TFic(5, C))
Select Case C
Case 2: VerserDonnées WshRuptur, WbkDon
Case 3: VerserDonnées WshExtRea, WbkDon
Case 4: VerserDonnées WshRécept, WbkDon
Case 5: VerserDonnées WshCdeCX3, WbkDon
End Select
WbkDon.Close SaveChanges:=False
If VersementOK Then
TFic(2, C) = TFic(5, C)
TFic(3, C) = TFic(6, C)
TFic(4, C) = Now
End If
End If
Next C
End If
RngFic.Value = TFic
End Sub
Sub VerserDonnées(ByVal WshCible As Worksheet, ByVal WbkSource As Workbook)
Dim RngSource As Range
VersementOK = False
Set RngSource = WbkSource.Worksheets(1).UsedRange
Application.Goto RngSource
'If MsgBox("Actuellement sélectionné :" & vbLf & """" & RngSource.Address(False, False, xlA1, True) & """." _
' & vbLf & "Ce contenu sélectionné doit-il remplacer celui de la feuille :" _
'& vbLf & """[" & ThisWorkbook.Name & "]" & WshCible.Name & """ ?", _
' vbYesNo, "VerserDonnées") = vbNo Then Exit Sub
WshCible.Cells.ClearContents
RngSource.Copy Destination:=WshCible.[A1]
VersementOK = True
End Sub