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 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93
| Sub age()
'
' age Macro
' Macro enregistrée le 15/05/2007 par Alexandre
'
' Touche de raccourci du clavier: Ctrl+a
'
For Each lafeuille In Application.Worksheets
nomfeuille = InputBox("que voulez vous donner comme nom à la feuille")
lafeuille.Name = nomfeuille
Next lafeuille
Dim datenais As Date
Dim ageentree As Integer
Dim carriere As Integer
Dim ageperso As Integer
Dim ageperso2 As Integer
MsgBox "cette macro va afficher un nom", 1, "macro age"
nombre = InputBox("pour combien de personne voulez vous calculer l'age?")
For i = 1 To nombre
UserFormage.Show
Cells(i, 1) = UserFormage.naam.Text
Cells(i, 8) = UserFormage.ListBox1.Text
naissance: datenais = UserFormage.datnais.Text
ageentree = UserFormage.agecar.Text
Call message(ageentree)
carriere = ancar
Call message(carriere)
ageperso = ageentree + carriere
ageperso2 = calculage(datenais)
If ageperso2 > 55 And ageperso2 < 60 Then
Cells(i, 6) = "pre-Pensionne"
Select Case ageperso2
Case 55
Cells(i, 7) = "encore 5 ans"
Case 56
Cells(i, 7) = "encore 4ans"
Case 57
Cells(i, 7) = "encore 3ans"
Case 58
Cells(i, 7) = "encore 2"
Case 59
Cells(i, 7) = "encore 1"
End Select
ElseIf ageperso2 >= 60 Then
Cells(i, 6) = "pensione"
c = c + 1
a = a + carriere
Else
Cells(i, 6) = ageperso
End If
Cells(i, 2) = datenais
Cells(i, 3) = ageentree
Cells(i, 4) = carriere
Cells(i, 5) = ageperso
Range("A1:G" & i).Select
Selection.Font.Bold = True
Columns("A:A").EntireColumn.AutoFit
Range("A1:A" & i).Select
For Each cellule In Selection
cellule.Value = UCase(cellule.Formula)
Next cellule
Unload UserFormage
Next i
If c <> 0 Then
MsgBox "il y a " & c & " pensionnés avec un total de " & a & "années de carriere"
End If
End Sub
Public Function calculage(datenais)
calculage = Year(Now - datenais) - 1900
End Function
Public Sub message(rep)
reponse = MsgBox("vous avez repondu " & rep, 4)
If reponse = vbNo Then
rep = InputBox("donnez la bonne réponse")
End If
End Sub |
Partager