Need help creating a document with 365 images, with a day of the year 2018 captioned on each image.

caarodriguez · #1 11-01-2017, 10:32 PM

Hi,

I am trying to create a christmas gift for my mom. I would like to insert 365 family photos into my word document and run a macro that will sequentially add captioned dates to each image. Basically an image for each day of 2018.

example..
photo 1 with caption January 1st 2018
photo 2 with caption January 2nd 2018
etc

Any help with this would be very much appreciated.

gmayor · #2 11-02-2017, 01:29 AM

Without knowing how the images are inserted it is something of a guess, but the following will insert the date in the required format after each image.

Code:

Sub Macro1()
'Graham Mayor - http://www.gmayor.com - Last updated - 02 Nov 2017
Dim iShp As Integer
Dim dStartDate As Date
Dim oRng As Range
Dim strDate As String
    dStartDate = "01/01/2018"
    For iShp = 1 To ActiveDocument.InlineShapes.Count
        strDate = Format((dStartDate + iShp), "mmmm d") & _
                DateOrdinal(Format((dStartDate + iShp), "d")) & _
                Format((dStartDate + iShp), " yyyy")
        Set oRng = ActiveDocument.InlineShapes(iShp).Range
        oRng.Collapse 0
        oRng.Text = vbCr & strDate & vbCr
        Set oRng = oRng.Paragraphs(2).Range
        oRng.Font.Size = 24
        oRng.ParagraphFormat.Alignment = wdAlignParagraphCenter
    Next iShp
lbl_Exit:
    Set oRng = Nothing
    Exit Sub
End Sub

caarodriguez · #3 11-03-2017, 07:00 PM

Thanks, I tried it.

I get an error saying "DateOrdinal" Compile Error: sub or function not defined.

I use insert -> pictures to get the images into my document.

macropod · #4 11-03-2017, 08:25 PM

You could add the following function to the same code module you use for Graham's code:

Code:

Function DateOrdinal(Val As Long) As String
Dim strOrd As String
If (Val Mod 100) < 11 Or (Val Mod 100) > 13 Then strOrd = Choose(Val Mod 10, "st", "nd", "rd") & ""
DateOrdinal = IIf(strOrd = "", "th", strOrd)
End Function

caarodriguez · #5 11-03-2017, 10:10 PM

Thanks it works! Just one issue, the first image is dated January 2nd, 2018. Any idea how I can get it to start from January 1st?

macropod · #6 11-03-2017, 10:17 PM

You could change:
dStartDate = "01/01/2018"
to:
dStartDate = CDate("01/01/2018") - 1

macropod · #7 11-03-2017, 10:54 PM

Here's a slightly different approach that centres the pics horizontally, adds the date to the next line of the same paragraph, and superscripts the ordinals.

Code:

Sub AddPicDatesBelow()
Application.ScreenUpdating = False
Dim iShp As Long, dStartDate As Date, oRng As Range, strOrd As String
dStartDate = CDate("01/01/2018") - 1
With ActiveDocument
  For iShp = 1 To .InlineShapes.Count
    dStartDate = dStartDate + 1
    strOrd = DateOrdinal(Format((dStartDate), "d"))
    Set oRng = .InlineShapes(iShp).Range
    With oRng
      .ParagraphFormat.Alignment = wdAlignParagraphCenter
      .Collapse wdCollapseEnd
      .Text = Chr(11) & Format((dStartDate), "mmmm d") & strOrd & Format((dStartDate), " yyyy") & vbCr
      .Start = .Start + 1
      .Font.Size = 24
      .Start = .Start + InStr(.Text, strOrd) - 1
      .End = .Start + 2
      .Font.Superscript = True
    End With
  Next iShp
End With
Set oRng = Nothing
Application.ScreenUpdating = True
End Sub

Function DateOrdinal(Val As Long) As String
Dim strOrd As String
If (Val Mod 100) < 11 Or (Val Mod 100) > 13 Then strOrd = Choose(Val Mod 10, "st", "nd", "rd") & ""
DateOrdinal = IIf(strOrd = "", "th", strOrd)
End Function

gmayor · #8 11-03-2017, 11:07 PM

Quote:

Originally Posted by caarodriguez

Thanks, I tried it.
I get an error saying "DateOrdinal" Compile Error: sub or function not defined.
I use insert -> pictures to get the images into my document.

Apologies - I forgot to include the dateordinal function. Paul's alternative should work equally well.

caarodriguez · #9 11-04-2017, 05:13 AM

Quote:

Originally Posted by gmayor

Apologies - I forgot to include the dateordinal function. Paul's alternative should work equally well.

Thanks alot, it works really well. Is it possible to put the dates above the images instead of below?

macropod · #10 11-04-2017, 05:57 AM

Try:

Code:

Sub AddPicDatesAbove()
Application.ScreenUpdating = False
Dim iShp As Long, dStartDate As Date, oRng As Range, strOrd As String
dStartDate = CDate("01/01/2018") - 1
With ActiveDocument
  For iShp = 1 To .InlineShapes.Count
    dStartDate = dStartDate + 1
    strOrd = DateOrdinal(Format((dStartDate), "d"))
    Set oRng = .InlineShapes(iShp).Range
    With oRng
      .ParagraphFormat.Alignment = wdAlignParagraphCenter
      .Collapse wdCollapseStart
      .Text = vbCr & Format((dStartDate), "mmmm d") & strOrd & Format((dStartDate), " yyyy") & Chr(11)
      .Start = .Start + 1
      .Font.Size = 24
      .Start = .Start + InStr(.Text, strOrd) - 1
      .End = .Start + 2
      .Font.Superscript = True
    End With
  Next iShp
End With
Set oRng = Nothing
Application.ScreenUpdating = True
End Sub

Function DateOrdinal(Val As Long) As String
Dim strOrd As String
If (Val Mod 100) < 11 Or (Val Mod 100) > 13 Then strOrd = Choose(Val Mod 10, "st", "nd", "rd") & ""
DateOrdinal = IIf(strOrd = "", "th", strOrd)
End Function

gmayor · #11 11-04-2017, 06:01 AM

Change

Code:

oRng.Collapse 0

to

Code:

oRng.Collapse 1

in my original macro thus

Code:

Option Explicit

Sub Macro1()
'Graham Mayor - http://www.gmayor.com - Last updated - 02 Nov 2017
Dim iShp As Integer
Dim dStartDate As Date
Dim oRng As Range
Dim strDate As String
    dStartDate = "31/12/2017"
    For iShp = 1 To ActiveDocument.InlineShapes.Count
        strDate = Format((dStartDate + iShp), "mmmm d") & _
                  DateOrdinal(Format((dStartDate + iShp), "d")) & _
                  Format((dStartDate + iShp), " yyyy")
        Set oRng = ActiveDocument.InlineShapes(iShp).Range
        oRng.Collapse 1
        oRng.Text = vbCr & strDate & vbCr
        Set oRng = oRng.Paragraphs(2).Range
        oRng.Font.Size = 24
        oRng.ParagraphFormat.Alignment = wdAlignParagraphCenter
    Next iShp
lbl_Exit:
    Set oRng = Nothing
    Exit Sub
End Sub

Private Function DateOrdinal(Val As Long) As String
Dim strOrd As String
    If (Val Mod 100) < 11 Or (Val Mod 100) > 13 Then strOrd = Choose(Val Mod 10, "st", "nd", "rd") & ""
    DateOrdinal = IIf(strOrd = "", "th", strOrd)
End Function

caarodriguez · #12 11-04-2017, 09:40 PM

Thanks for all your help

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
How to search for a specific year from a table with year range?	Wii	Excel	0	05-05-2015 12:40 PM
How to calculate a rolling year-to-date percentage by quarter as the year progresses	sleake	Excel Programming	2	04-23-2015 11:51 AM
Need advice on creating new .pst files every year	Rockitman31	Outlook	1	03-02-2013 08:00 AM
Creative Ways for a year-to-year comparison???	ridonkulous5	Excel	1	03-23-2011 04:49 PM
Referencing a Captioned Picture	ComcoDG	Word	0	11-10-2008 04:40 PM