Discussion :

[forum2015]

Bonjour tout le monde,

J'ai codé un petit programme (en utilisant un autre programme existant déjà) permettant de calculer l'âge d'une personne à partir de sa date de naissance.
Le problème est que lorsque je compile le code, tout se passe bien mais lors de la lecture du classeur excel, il apparait un problème de lisibilité.

J'ai donc deux colonnes, une colonne avec les dates de naissance et une colonne vide avec les ages respectifs. Après compilation, la colonne des ages est remplie correctement mais la colonne des dates de naissance n'est plus lisible. Dans la barre de formule des cellules de cette colonne on lit bien la date de naissance (bon format : dd/mm/yyyy) mais directement sur la cellule, il n'apparait que des dieses (ou des dieses séparé par des slash, je ne me souviens plus bien). Je trouve cela étonnant car mon programme, bien qu'utilisant la colonne des dates de naissance, n'agit pas dessus. Je pense que c'est un pb du à Excel et à son format de date (procedure interne automatique) mais je ne vois pas plus. Je ne sais pas comment faire pour résoudre le problème.

Voici le code en question :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
'procedure that updates the age of the patient in the column 'EDAD'
' j : position of the patient in the database
Sub agepatient(ByVal j As Integer)
 
Dim i As Integer
 
With ThisWorkbook.Worksheets("BASE TOTAL")
 
'if there is no data, we can't update
If .Cells(j, positionfndatabase).Value = "" Then
    'MsgBox "Error with the patient number " & j & ". We don't know his date of birth. Please, deal with it manually at the end of the updating."
 
Else
 
    Dim Date1 As String
    Dim Date2 As String
 
    'if date of birth = jj/mm/yyyy
    If .Cells(j, positionfndatabase).Value Like "[0-9][0-9]/[0-9][0-9]/[0-9][0-9][0-9][0-9]" Then
        'date of birth (in the format dd/mm/yyyy, as String)
        Date1 = CStr(.Cells(j, positionfndatabase).Value)
 
    'if date of birth = yyyy
    ElseIf .Cells(j, positionfndatabase).Value Like "[0-9][0-9][0-9][0-9]" Then
        'date of birth (in the format : 1/1/yyyy, as String)
        Date1 = CStr("1/1/" & .Cells(j, positionfndatabase).Value)
 
    'case of error
    Else
        MsgBox "Error with the patient number " & j & ". Please, deal with it manually at the end of the updating."
        Exit Sub
    End If
 
    'date of today (in the format dd/mm/yyyy, as String)
    Date2 = CStr(Format(Now(), "dd/mm/yyyy"))
 
    'if the difference of year between the two dates is 0
    If Left(age(Date1, Date2), 1) = "0" Then
        'we copy 0
        .Cells(j, positionedaddatabase).Value = 0
        .Cells(j, positionedaddatabase).HorizontalAlignment = xlCenter
 
    'if the difference of year between the two dates is strictly positive
    ElseIf Left(age(Date1, Date2), 1) > 0 Then
        'we copy the number of years
        .Cells(j, positionedaddatabase).Value = Left(age(Date1, Date2), InStr(age(Date1, Date2), " year") - 1)
        .Cells(j, positionedaddatabase).HorizontalAlignment = xlCenter
 
    'case of error
    Else
        MsgBox "Error with the patient number " & j & ". Please, deal with it manually at the end of the updating."
 
    End If
 
End If
 
End With
 
End Sub
 
'function that calculates the difference between 2 dates (format : "dd/mm/yyyy") and returns 'x years, y months and z days'
Function age(ByVal Date1 As Date, ByVal Date2 As Date) As String
    Dim Y As Integer
    Dim M As Integer
    Dim D As Integer
    Dim Temp1 As Date
    Temp1 = DateSerial(Year(Date2), Month(Date1), Day(Date1))
    Y = Year(Date2) - Year(Date1) + (Temp1 > Date2)
    M = Month(Date2) - Month(Date1) - (12 * (Temp1 > Date2))
    D = Day(Date2) - Day(Date1)
    If D < 0 Then
        M = M - 1
        D = Day(DateSerial(Year(Date2), Month(Date2) + 1, 0)) + D + 1
    End If
    age = Y & " years " & M & " months " & D & " days"
End Function

Merci pour vos remarques

[Patrice740]

Bonjour,

C'est peut-être simplement du à une largeur colonne insuffisante.
juste avant le End With, ajoutes :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.Columns.AutoFit

[forum2015]

Effectivement tu as raison. A la main, en mettant la bonne taille de colonne les dates apparaissent correctement.

Ce qui est étrange est que j'avais déjà mis avant ta ligne de code et elle n'est pas pris en compte. J'ai donc modifié et mis cela :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
With ThisWorkbook.Worksheets("BASE TOTAL")
    .Rows.AutoFit
    .Columns.AutoFit
End With

Mais au final c'est pareil, pas de changement... Bizarre...

[Docmarti]

Pour augmenter les chances, utilise aussi ShrinkToFit :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
.Columns("A:D").AutoFit
.Columns("A:D").ShrinkToFit = True

[forum2015]

Effectivement sa marche niquel maintenant ! Merci