Bonjour à tous
J'ai une liste de mes collègues (200personnes) avec leur date de fête et
je voudrait faire une macro qui me donnerais les trois prochaine fête,
cela dans une boite message que j'intègrerais a un autre fichier
a l'ouverture.
Merci
Bonjour à tous
J'ai une liste de mes collègues (200personnes) avec leur date de fête et
je voudrait faire une macro qui me donnerais les trois prochaine fête,
cela dans une boite message que j'intègrerais a un autre fichier
a l'ouverture.
Merci
Bonjour à tous
J'ai une liste de mes collègues (200personnes) avec leur date de fête et
je voudrait faire une macro qui me donnerais les trois prochaine fête,
cela dans une boite message que j'intègrerais a un autre fichier
a l'ouverture.
Merci
Salut Daniel,
Un truc dans le genre ?
'-----------
Sub Les3Dates()
Dim Tbl
Dim I As Long, J As Long
Dim Tempo As Date
Dim Max As Long
Dim DateFetes As String
With Worksheets("Feuil1")
Tbl = .Range(.[A1], .[A65536].End(xlUp))
End With
Max = UBound(Tbl, 1)
'Tri croissant du tableau
For I = 1 To Max - 1
For J = I + 1 To Max
If Tbl(I, 1) > Tbl(J, 1) Then
Tempo = Tbl(J, 1)
Tbl(J, 1) = Tbl(I, 1)
Tbl(I, 1) = Tempo
End If
Next J
Next I
J = 0
DateFetes = "Les 3 prochaines fêtes sont :" & _
vbCrLf & vbCrLf
For I = 1 To Max
If Date < Tbl(I, 1) Then
DateFetes = DateFetes & _
Tbl(I, 1) & _
vbCrLf
J = J + 1
End If
If J = 3 Then Exit For
Next I
MsgBox DateFetes
Erase Tbl
End Sub
'----------------
Hervé.
"Daniel" a écrit dans le message news:
AxHWd.2065$Bonjour à tous
J'ai une liste de mes collègues (200personnes) avec leur date de fête et
je voudrait faire une macro qui me donnerais les trois prochaine fête,
cela dans une boite message que j'intègrerais a un autre fichier
a l'ouverture.
Merci
Salut Daniel,
Un truc dans le genre ?
'-----------
Sub Les3Dates()
Dim Tbl
Dim I As Long, J As Long
Dim Tempo As Date
Dim Max As Long
Dim DateFetes As String
With Worksheets("Feuil1")
Tbl = .Range(.[A1], .[A65536].End(xlUp))
End With
Max = UBound(Tbl, 1)
'Tri croissant du tableau
For I = 1 To Max - 1
For J = I + 1 To Max
If Tbl(I, 1) > Tbl(J, 1) Then
Tempo = Tbl(J, 1)
Tbl(J, 1) = Tbl(I, 1)
Tbl(I, 1) = Tempo
End If
Next J
Next I
J = 0
DateFetes = "Les 3 prochaines fêtes sont :" & _
vbCrLf & vbCrLf
For I = 1 To Max
If Date < Tbl(I, 1) Then
DateFetes = DateFetes & _
Tbl(I, 1) & _
vbCrLf
J = J + 1
End If
If J = 3 Then Exit For
Next I
MsgBox DateFetes
Erase Tbl
End Sub
'----------------
Hervé.
"Daniel" <pellet15@videotron.ca> a écrit dans le message news:
AxHWd.2065$Gn2.261843@weber.videotron.net...
Bonjour à tous
J'ai une liste de mes collègues (200personnes) avec leur date de fête et
je voudrait faire une macro qui me donnerais les trois prochaine fête,
cela dans une boite message que j'intègrerais a un autre fichier
a l'ouverture.
Merci
Salut Daniel,
Un truc dans le genre ?
'-----------
Sub Les3Dates()
Dim Tbl
Dim I As Long, J As Long
Dim Tempo As Date
Dim Max As Long
Dim DateFetes As String
With Worksheets("Feuil1")
Tbl = .Range(.[A1], .[A65536].End(xlUp))
End With
Max = UBound(Tbl, 1)
'Tri croissant du tableau
For I = 1 To Max - 1
For J = I + 1 To Max
If Tbl(I, 1) > Tbl(J, 1) Then
Tempo = Tbl(J, 1)
Tbl(J, 1) = Tbl(I, 1)
Tbl(I, 1) = Tempo
End If
Next J
Next I
J = 0
DateFetes = "Les 3 prochaines fêtes sont :" & _
vbCrLf & vbCrLf
For I = 1 To Max
If Date < Tbl(I, 1) Then
DateFetes = DateFetes & _
Tbl(I, 1) & _
vbCrLf
J = J + 1
End If
If J = 3 Then Exit For
Next I
MsgBox DateFetes
Erase Tbl
End Sub
'----------------
Hervé.
"Daniel" a écrit dans le message news:
AxHWd.2065$Bonjour à tous
J'ai une liste de mes collègues (200personnes) avec leur date de fête et
je voudrait faire une macro qui me donnerais les trois prochaine fête,
cela dans une boite message que j'intègrerais a un autre fichier
a l'ouverture.
Merci
Bonjour à tous
J'ai une liste de mes collègues (200personnes) avec leur date de fête et
je voudrait faire une macro qui me donnerais les trois prochaine fête,
cela dans une boite message que j'intègrerais a un autre fichier
a l'ouverture.
Merci
Bonjour à tous
J'ai une liste de mes collègues (200personnes) avec leur date de fête et
je voudrait faire une macro qui me donnerais les trois prochaine fête,
cela dans une boite message que j'intègrerais a un autre fichier
a l'ouverture.
Merci
Bonjour à tous
J'ai une liste de mes collègues (200personnes) avec leur date de fête et
je voudrait faire une macro qui me donnerais les trois prochaine fête,
cela dans une boite message que j'intègrerais a un autre fichier
a l'ouverture.
Merci
Bonjour
j'utilise ce qui suit avec bonheur (auteur entre les ****)
@+
J@@ (déjà envoyé à 9:52 de chez moi - il y a plus de 7 heures-, mais rien
n'apparait :-<<< )
*****
Ne pas oublier de souhaiter les anniversaires ?
...Pour un utilisateur assidu d'Excel, pas de problème, il suffit de
demander à votre logiciel favori d'envoyer un petit message de rappel à
l'ouverture d'Excel quelques jours avant le jour J.
Une liste des noms et des dates de naissances.
Une macro complémentaire qui à chaque ouverture d'Excel balaie la liste et
se manifeste en cas de besoin.
Et pour une installation confortable et une mise à jour commode, une macro
d'installation / mise à jour.
En pratique,
- ouvrir un nouveau classeur,
- télécharger la feuille de macros "module_anniv.bas" et l'insérer dans un
nouveau module du classeur (par Outils / Macro / Visual Basic Editor /
Fichier / Importer un fichier).
- lancer la macro "création_liste"
- remplir la liste ainsi créée avec les noms et les dates de naissances
- enregistrer le fichier sur le disque dur sous le nom "anniversaires.xls"
- cliquer sur le bouton
- et attendre patiemment la prochaine date d'anniversaire.
(bien que le fichier Excel ne soit plus indispensable, il vaut mieux le
conserver pour pouvoir faire aisément les mises à jour éventuelles)
Comment ça marche ?
- La macro "création_liste" met en forme la page devant servir à stocker
les
dates de naissance,
- puis elle crée une macro "WorkbookOpen" dans la page de code de
"ThisWorkbook" qui lance la macro "anniversaire" (celle qui envoie les
messages)
- Et elle crée un bouton permettant de lancer l'implantation de la macro
complémentaire (qui permet d'installer la macro, puis de faire les mises à
jour).
=== > Attribute VB_Name = "Module1"
' 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:="þuil1!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
=== > ****
********
"Daniel" a écrit dans le message de news:
AxHWd.2065$Bonjour à tous
J'ai une liste de mes collègues (200personnes) avec leur date de fête et
je voudrait faire une macro qui me donnerais les trois prochaine fête,
cela dans une boite message que j'intègrerais a un autre fichier
a l'ouverture.
Merci
Bonjour
j'utilise ce qui suit avec bonheur (auteur J@C entre les ****)
@+
J@@ (déjà envoyé à 9:52 de chez moi - il y a plus de 7 heures-, mais rien
n'apparait :-<<< )
*****
Ne pas oublier de souhaiter les anniversaires ?
...Pour un utilisateur assidu d'Excel, pas de problème, il suffit de
demander à votre logiciel favori d'envoyer un petit message de rappel à
l'ouverture d'Excel quelques jours avant le jour J.
Une liste des noms et des dates de naissances.
Une macro complémentaire qui à chaque ouverture d'Excel balaie la liste et
se manifeste en cas de besoin.
Et pour une installation confortable et une mise à jour commode, une macro
d'installation / mise à jour.
En pratique,
- ouvrir un nouveau classeur,
- télécharger la feuille de macros "module_anniv.bas" et l'insérer dans un
nouveau module du classeur (par Outils / Macro / Visual Basic Editor /
Fichier / Importer un fichier).
- lancer la macro "création_liste"
- remplir la liste ainsi créée avec les noms et les dates de naissances
- enregistrer le fichier sur le disque dur sous le nom "anniversaires.xls"
- cliquer sur le bouton
- et attendre patiemment la prochaine date d'anniversaire.
(bien que le fichier Excel ne soit plus indispensable, il vaut mieux le
conserver pour pouvoir faire aisément les mises à jour éventuelles)
Comment ça marche ?
- La macro "création_liste" met en forme la page devant servir à stocker
les
dates de naissance,
- puis elle crée une macro "WorkbookOpen" dans la page de code de
"ThisWorkbook" qui lance la macro "anniversaire" (celle qui envoie les
messages)
- Et elle crée un bouton permettant de lancer l'implantation de la macro
complémentaire (qui permet d'installer la macro, puis de faire les mises à
jour).
=== > 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:="þuil1!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
=== > ****
********
"Daniel" <pellet15@videotron.ca> a écrit dans le message de news:
AxHWd.2065$Gn2.261843@weber.videotron.net...
Bonjour à tous
J'ai une liste de mes collègues (200personnes) avec leur date de fête et
je voudrait faire une macro qui me donnerais les trois prochaine fête,
cela dans une boite message que j'intègrerais a un autre fichier
a l'ouverture.
Merci
Bonjour
j'utilise ce qui suit avec bonheur (auteur entre les ****)
@+
J@@ (déjà envoyé à 9:52 de chez moi - il y a plus de 7 heures-, mais rien
n'apparait :-<<< )
*****
Ne pas oublier de souhaiter les anniversaires ?
...Pour un utilisateur assidu d'Excel, pas de problème, il suffit de
demander à votre logiciel favori d'envoyer un petit message de rappel à
l'ouverture d'Excel quelques jours avant le jour J.
Une liste des noms et des dates de naissances.
Une macro complémentaire qui à chaque ouverture d'Excel balaie la liste et
se manifeste en cas de besoin.
Et pour une installation confortable et une mise à jour commode, une macro
d'installation / mise à jour.
En pratique,
- ouvrir un nouveau classeur,
- télécharger la feuille de macros "module_anniv.bas" et l'insérer dans un
nouveau module du classeur (par Outils / Macro / Visual Basic Editor /
Fichier / Importer un fichier).
- lancer la macro "création_liste"
- remplir la liste ainsi créée avec les noms et les dates de naissances
- enregistrer le fichier sur le disque dur sous le nom "anniversaires.xls"
- cliquer sur le bouton
- et attendre patiemment la prochaine date d'anniversaire.
(bien que le fichier Excel ne soit plus indispensable, il vaut mieux le
conserver pour pouvoir faire aisément les mises à jour éventuelles)
Comment ça marche ?
- La macro "création_liste" met en forme la page devant servir à stocker
les
dates de naissance,
- puis elle crée une macro "WorkbookOpen" dans la page de code de
"ThisWorkbook" qui lance la macro "anniversaire" (celle qui envoie les
messages)
- Et elle crée un bouton permettant de lancer l'implantation de la macro
complémentaire (qui permet d'installer la macro, puis de faire les mises à
jour).
=== > Attribute VB_Name = "Module1"
' 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:="þuil1!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
=== > ****
********
"Daniel" a écrit dans le message de news:
AxHWd.2065$Bonjour à tous
J'ai une liste de mes collègues (200personnes) avec leur date de fête et
je voudrait faire une macro qui me donnerais les trois prochaine fête,
cela dans une boite message que j'intègrerais a un autre fichier
a l'ouverture.
Merci
