(RESOLU) Bug date inversée 07/03/1955 - 03/07/1955 ? dans une macro

[LBi]

Bonsoir,

Je ne trouve pas le Bug...
Quand j’importe le fichier "essai date de naissance" dans le classeur tableau biologique en lançant la macro1 après appui sur le bouton "insérer résultat" la date de naissance qui était le 07/03/1955 dans le fichier "essai date de naissance" se change en 03/07/1955 dans la feuille Entrée du Tableau biologique essai, cela arrive aussi avec la date d'examen sur d'autre fichier biologique à importer!
Autre bizarrerie, quand la date incriminée est par exemple 24/12/1999, elle ne change pas. La date inverse 12/24/1999 étant impossible.
Je sèche sur la résolution de ce problème.
En fichier joint le tableau biologique et le fichier "essai date de naissance" à importer dans le tableau biologique et le fichier patient.

Les macros:

Sub Macro1()
Dim t, chemin$, DerCol%
t = Array(Array(1, 9), Array(2, 9), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1))
ThisWorkbook.Sheets("Entrée").Cells.Clear
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Sélectionner votre fichier, svp": .AllowMultiSelect = False: .Filters.Clear: .Filters.Add "Fichiers TXT", "*.txt", 1
.FilterIndex = 1: .InitialView = msoFileDialogViewProperties
If .Show Then
chemin = .SelectedItems(1): Application.ScreenUpdating = False
Macro2 chemin
Workbooks.OpenText chemin, StartRow:=2, DataType:=xlDelimited, Other:=True, OtherChar:="|", FieldInfo:=t
ActiveWorkbook.Sheets(1).UsedRange.Copy ThisWorkbook.Sheets("Entrée").Range("A1")
ActiveWorkbook.Close False
Sheets("Entrée").UsedRange.Replace "Ç", "é"
With Sheets("T1")
.Protect , UserInterfaceOnly:=True 'la protection est ignorée
DerCol = .Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).Column
If DerCol > 6 Then .Columns(DerCol - 4).Resize(, 4).Copy .Columns(DerCol) 'pour copier les formats
'------------
.Cells(1, DerCol) = .Cells(1, DerCol - 4) + 1
.Cells(2, DerCol) = Sheets("Nouvelle").Range("F135")
If IsDate(Sheets("Nouvelle").Range("F1")) Then .Cells(3, DerCol) = CDate(Sheets("Nouvelle").Range("F1"))
.Cells(4, DerCol).Resize(119, 4) = Sheets("Nouvelle").Range("F2:I120").Value
End With
Else
MsgBox "Vous n'avez pas sélectionné de fichier!", vbCritical, "ERREUR"
End If
End With
End Sub
-----------------------------------------------------------------------------------------------------------------------------
Sub Macro2(fichier$)
Dim n&, a$()
'---lecture---
Open fichier For Input As #1 '1ère ouverture
While Not EOF(1) 'EndOfFile: fin du fichier
n = n + 1
ReDim Preserve a(1 To n)
Line Input #1, a(n)
Wend
Close #1 '1ère fermeture
'---modif---
If a(2) Like "TEX|nom|NOM|x|*" Then Exit Sub 'si le fichier a déjà été modifié
a(2) = "TEX|nom|NOM|x|" & a(2)
a(3) = "TEX|prénom|PRENOM|x|" & a(3)
a(7) = "TEX|date de naissance|DATENAIS|x|" & a(7)
a(10) = "TEX|date d'examen|DATEEXAM|x|" & a(10)
a(14) = "TEX|Labo|LABO|x|" & a(14)
'---écriture---
Open fichier For Output As #1 '2ème ouverture
Print #1, Join(a, vbCrLf)
Close #1 '2ème fermeture
End Sub

Merci de votre aide

 

[job75]

Bonjour LBi, le forum,

Il faut préciser l'argument Local:=True dans cette instruction :

        Workbooks.OpenText chemin, StartRow:=2, DataType:=xlDelimited, Other:=True, OtherChar:="|", FieldInfo:=t, Local:=True

Vos fichiers en retour.

Bonne journée.

 

[LBi]

Merci pour la solution 🙂
Les voies d'excel sont impénétrables pour moi.

Ps: Je viens de trouver la solution de l'autre fil https://www.excel-downloads.com/threads/macro-graphique-simple.20025742/#post-20195316 , je voulais que la Feuille T1 se remplisse au fur et à mesure des importations avec formatage des données .
L'erreur venait que je supprimais à partir de F toutes les colonnes sur la droite et donc quand j'importais les résultats, il n'y avait pas le bon formatage. Le fait de garder les premières colonnes FGHI , le formatage est correct et donc le fichier pèse 78 Ko au lieu de 241 Ko.