Implanter une macro complémentaire à l'ouverture d'un fichier source

télécharger et lancer la macro (fichier.zip)

 


Private Sub Workbook_Open()
Application.EnableCancelKey = xlDisabled
'vérifie si agenda est implanté
If ThisWorkbook.Name = "agenda.xla" And ThisWorkbook.IsAddin = True Then
abscisse = 31 * ((Month(DateTime.Now) - 1) - 3 * Int((Month(DateTime.Now) - 1) / 3)) + Day(DateTime.Now)
If Feuil1.Cells(abscisse, 1 + Int((Month(DateTime.Now) - 1) / 3)) <> "" Then
MsgBox (Feuil1.Cells(abscisse, 1 + Int((Month(DateTime.Now) - 1) / 3)))
End If
End If
If ThisWorkbook.Name = "AGENDAsource.xls" Then
envoi
ThisWorkbook.Close (False)
End If
End Sub

A l'ouverture du fichier (à chaque ouverture d'Excel), la macro complémentaire "agenda.xla" annonce le jour et le dicton du jour (les dictons sont classés, un trimestre par colonne, dans la feuille Feuil1).

Le test sur ThisWorkbook.Name permet de savoir si le classeur actif est le classeur source (AGENDAsource.xls) ou la macro complémentaire (agenda.xla). Dans le premier cas, la macro démarre le programme "envoi" ci-dessous qui va implanter la macro complémentaire.

'________________________________________


Sub envoi()
Application.EnableCancelKey = xlDisabled

'au lancement de ce sub, le programme est transformé
'en macro complémentaire installée dans macrolib
'vérifier l'absence de agenda.xla dans macrolib
If Dir(Application.LibraryPath & "\agenda.xla") <> "" Then
On Error GoTo err
AddIns("agenda").Installed = False
err:
On Error GoTo 0
Kill Application.LibraryPath & "\agenda.xla"
End If
'copier sous agenda.xla
ThisWorkbook.SaveCopyAs FileName:=Application.LibraryPath & "\agenda.xla"
'transformer agenda.xla en macro compl
Workbooks.Open FileName:=Application.LibraryPath & "\agenda.xla"
ActiveWorkbook.IsAddin = True
Workbooks("agenda.xla").Close (True)
AddIns.Add(Application.LibraryPath & "\agenda.xla").Installed = True
Workbooks("AGENDAsource.xls").Close (False)
End Sub

Voir aussi la version HTML / JavaScript du dicton du jour