print an organizer/agenda

[Osiris]

I would like to design my own organizer, to be printed.
There is a program for that ("readytoprint"), but it is not flexible
enough for my taste.
I wondered if I could do it in WORD.
The idea is, to generate automatically 365 pages with the day,
weekday, month, day of month, etc., printed in the header.

anyone an idea ?

 

[Doug Robbins - Word MVP]

Running the following macro when a blank document is open will do that:

Dim i As Long
Dim myrange As Range
Dim start As Date
start = CDate(InputBox("Enter the start date (m/d/yyyy)"))
With ActiveDocument
.Sections(1).Headers(wdHeaderFooterPrimary).Range.InsertAfter
Format(start, "dddd, d MMMM yyyy")
For i = 1 To 3 '65
Set myrange = .Range
myrange.Collapse wdCollapseEnd
myrange.InsertBreak wdSectionBreakNextPage
With .Sections(i + 1).Headers(wdHeaderFooterPrimary)
.LinkToPrevious = False
.Range.Delete
.Range.InsertAfter Format(DateAdd("d", i, start), "dddd, d MMMM
yyyy")
End With
Next i
End With

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

 

[Osiris]

Running the following macro when a blank document is open will do that:

Dim i As Long
Dim myrange As Range
Dim start As Date
start = CDate(InputBox("Enter the start date (m/d/yyyy)"))
With ActiveDocument
.Sections(1).Headers(wdHeaderFooterPrimary).Range.InsertAfter
Format(start, "dddd, d MMMM yyyy")
For i = 1 To 3 '65
Set myrange = .Range
myrange.Collapse wdCollapseEnd
myrange.InsertBreak wdSectionBreakNextPage
With .Sections(i + 1).Headers(wdHeaderFooterPrimary)
.LinkToPrevious = False
.Range.Delete
.Range.InsertAfter Format(DateAdd("d", i, start), "dddd, d MMMM
yyyy")
End With
Next i
End With

Thnx a lot !
good start for me to get going in programming in VB a bit ;-)

 

[Osiris]

Thnx again:

I now have a nice macro that generates my Filofax-filling for any
year I want. I just type the year, and the macro starts running,
generating 365 pages, each with it's own header with the appropriate
date info, room for my dayly appointments, a note space and at the
bottom two monthly calenders.

Now I want to get at my Outlook contacts, to print birthdays too....

 

[Osiris]

Thnx again:

I now have a nice macro that generates my Filofax-filling for any
year I want. I just type the year, and the macro starts running,
generating 365 pages, each with it's own header with the appropriate
date info, room for my dayly appointments, a note space and at the
bottom two monthly calenders.

Now I want to get at my Outlook contacts, to print birthdays too....

and I found that one too:

Private Function FindContact(d As Date) As String
'Finds and displays Birthday for a contact

Dim olApp As Outlook.Application
Dim objContact As Outlook.ContactItem
Dim objContacts As Outlook.MAPIFolder
Dim objNameSpace As Outlook.NameSpace
Dim objProperty As Outlook.UserProperty
Dim strDate As String

strDate = Format(d, "m/d/yyyy", vbMonday, vbFirstFourDays)
Set olApp = CreateObject("Outlook.Application")
Set objNameSpace = olApp.GetNamespace("MAPI")
Set objContacts = objNameSpace.GetDefaultFolder(olFolderContacts)
Set objContact = objContacts.Items.Find("[Birthday] = """ &
strDate & """")
If Not TypeName(objContact) = "Nothing" Then
FindContact = objContact.FullName & " has birthday"

Else
FindContact = ""
End If
End Function


More that one could be found of course....