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
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