Attribute VB_Name = "Module1"


'J@C déc 2000
Sub création_liste()
'créer la ligne d'entêtes
Sheets(1).Select
Cells(1) = "durée ="
Cells(1, 2) = 7
ActiveWorkbook.Names.Add Name:="durée", RefersToR1C1:="=Feuil1!R1C2"
Cells(1, 2).NumberFormat = """prévenir ""0"" jours avant la date"""
Cells(1, 2).HorizontalAlignment = xlLeft
Cells(2, 1) = "Date"
Cells(2, 2) = "nom"
Cells(3, 1).FormulaR1C1 = "12/4/1975"
Range("A1:B2").Interior.ColorIndex = 34
With Range("A2:B2").Font
    .ColorIndex = 41
    .FontStyle = "Gras"
    .Size = 12
End With
Cells(3, 2) = "Monique"
With Columns("A:B").Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = 32
End With
With Columns("A:B").Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = 32
End With
With Columns("A:B").Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = 32
End With
Columns("A:A").ColumnWidth = 7.57
Columns("B:B").ColumnWidth = 49.4
'ajoute un bouton
With ActiveSheet.Buttons.Add(171, 0.75, 135.75, 27.75)
    .OnAction = "implante_macro_compl"
    .Characters.Text = "Implanter la macro"
End With
'présentation de la page
With ActiveWindow
    .DisplayGridlines = False
    .DisplayHeadings = False
    .DisplayWorkbookTabs = False
End With

'ajoute une macro autoexec dans ThisWorkbook
ThisWorkbook.VBProject.VBComponents("ThisWorkBook").CodeModule.InsertLines 1, "Private Sub Workbook_Open()"
ThisWorkbook.VBProject.VBComponents("ThisWorkBook").CodeModule.InsertLines 2, "anniversaire"
ThisWorkbook.VBProject.VBComponents("ThisWorkBook").CodeModule.InsertLines 3, "End Sub"

End Sub



Sub anniversaire()
'envoie un message à l'ouverture de Excel
Set feuil = ThisWorkbook.Sheets(1)
demi = feuil.Range("durée") / 2
For lin = 1 To feuil.Cells.SpecialCells(xlCellTypeLastCell).Row
Set cel = feuil.Cells(lin, 1)
If IsDate(cel) Then
If Abs(Now - 1 + demi - DateValue(Day(cel) & " " & Month(cel) & " " & Year(Now))) < demi _
Or Abs(Now - 1 + demi - DateValue(Day(cel) & " " & Month(cel) & " " & Year(Now) + 1)) < demi Then
blabla = blabla & Chr(13) & Chr(13) & "Anniversaire de " & feuil.Cells(lin, 2) & " le " & Format(feuil.Cells(lin, 1), "dd mmm")
End If
End If
Next
If blabla <> "" Then MsgBox (blabla)
If ThisWorkbook.Name = "anniversaires.xla" Then ThisWorkbook.Close (False)
End Sub



Sub implante_macro_compl()
'suppr les macro compl "anniversaires" existantes
If Dir(Application.LibraryPath & "\anniversaires.xla") <> "" Then
On Error GoTo err
AddIns("anniversaires").Installed = False
err:
On Error GoTo 0
Kill Application.LibraryPath & "\anniversaires.xla"
End If
'copier dans le répertoire ds macros complémentaires
ThisWorkbook.SaveCopyAs Application.LibraryPath & "\anniversaires.xla"
'transf en macro compl
Workbooks.Open Application.LibraryPath & "\anniversaires.xla"
ActiveWorkbook.IsAddin = True
Workbooks("anniversaires.xla").Close (True)
'installer la marco complémentaire
AddIns.Add(Application.LibraryPath & "\anniversaires.xla").Installed = True
End Sub