Microsoft Office Forums - View Single Post - Please Help. Future date macro that updates automatically

Guessed · 08-05-2021, 11:53 PM

It looks like you are using macros anyway so I would do this with Content Controls and macros in the ThisDocument module. See attached demo document.
The code used is shown below to go along with a bunch of Content Controls I put into the demo document.

Code:

Private Sub Document_ContentControlOnEnter(ByVal thisCC As ContentControl)
  If thisCC.Title = "Today" And thisCC.ShowingPlaceholderText Then
    If thisCC.XMLMapping.IsMapped Then
      thisCC.XMLMapping.CustomXMLNode.Text = Format(Now, thisCC.DateDisplayFormat)
    End If
  ElseIf thisCC.Title = "Stay Days" And thisCC.ShowingPlaceholderText Then
    thisCC.Range.Text = InputBox("Please input the number of days for the stay duration", "Stay Duration (in days)", "1")
  End If
End Sub

Private Sub Document_ContentControlOnExit(ByVal thisCC As ContentControl, Cancel As Boolean)
  Dim aCC As ContentControl, iDays As Integer, sDateFormat As String, dtEnd As Variant, sFormat As String
  If thisCC.Title = "Today" Then
    If Not thisCC.ShowingPlaceholderText Then
      iDays = InputBox("Please input the number of days for the stay duration", "Stay Duration (in days)", "1")
      For Each aCC In ActiveDocument.SelectContentControlsByTitle("Stay Days")
        aCC.Range.Text = iDays
      Next aCC
      sFormat = thisCC.DateDisplayFormat
      thisCC.DateDisplayFormat = "d MMM yyyy"
      dtEnd = DateAdd("d", iDays, thisCC.Range.Text)
      For Each aCC In ActiveDocument.SelectContentControlsByTitle("Exit Date")
        sDateFormat = aCC.DateDisplayFormat
        aCC.Range.Text = Format(dtEnd, sDateFormat)
      Next aCC
      thisCC.DateDisplayFormat = sFormat
    End If
  End If
End Sub