Calculate Age From Content Controls

kintap · #1 06-24-2014, 12:51 PM

I have searched and found many references, but it is beyond my skill to get this to work with content controls

Previously my form was made with form fields and I was able to do the age calculations. However, we have moved towards content controls to allow better spell checking and text formatting.

Attached is partially converted form (the file extension needs to be renamed to .dotm, changed it to .zip in order to upload), any help is great. I am really stumped.

macropod · #2 06-24-2014, 04:59 PM

I am unable to open your document after renaming. perhaps you could add it to a zip archive and upload that.

kintap · #3 06-26-2014, 11:58 AM

Sorry about that, and this late reply, I was away. I have attached a zipped copy here.

As well, I thought I would give a little more info of what I am trying to do. There are 2 content controls (both in the top 1/4 of the first page) in the document First Contact Date and DOB. I am trying to calculate the Age of a person based on these values and then populate them into the Age box (right now shows a form field, if I can populate and calculate this to insert into a content control that would be best).

All of the methods that I have tried seem to only work with form fields, or only do simple + - calculations in content controls.

Thank you macropod for even taking a look.

macropod · #4 06-26-2014, 05:01 PM

Try the following streamlined version of your on-exit macro:

Code:

Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
With ContentControl
  Select Case .Title
    Case "HomePhone", "CellPhone", "WorkPhone", "OtherRefererPhone", "GuardianPhone", "EmergencyContactPhone", "PhysicianPhone"
      .Range.Text = Format(.Range.Text, "(###) ###-####")
    Case "PHN"
      .Range.Text = Format(.Range.Text, "#####-####")
  Case "ApptTimeTop"
    .Range.Text = Format(.Range.Text, "@ #########")
  Case "DateOfBirth"
    ContentControl.Range.Tables(1).Cell(6, 1).Range.Paragraphs.Last.Range.Text = DateDiff("yyyy", CDate(.Range.Text), Now)
  End Select
End With
End Sub

kintap · #5 06-27-2014, 08:40 AM

Paul,

Thank you for this, it does work beyond what I have been able to do. How do I alter the code to ensure that the Age is correct based on month as well.

For instance:
Oct 1 1980 would be 33 years old but with this calculation it is 34 as it only looks at the yyyy.

Thank you for all your help on this, wish I came here months ago.

Kyle

kintap · #6 06-27-2014, 10:18 AM

Hi Paul,

I have a followup. Though the code works and inserts the value into the cell, is there a way to insert that into a field or content control. The reason being is I used the age to programatically insert text based on age range.

For reference, when i used form fields, this was the code I used for calculating age and inserting text based on age to a bookmark.

Code:

Public Sub CalcAge()

    'This code will only work if you have two form fields named
    'BirthDate and Age in the active document. In the properties of
    'the DateOfBirth field, set the "Run Macro on Exit" value to the name
    'of this procedure.

    Dim objAge As Word.FormField
    Dim objBirthDate As Word.FormField
    
    Dim datToday  As Date
    Dim intAge    As Integer
    Dim intYears  As Integer
    
    'Set today's date
    datToday = Date
        
    'Get the form fields associated with the birthdate and the age.
    Set objAge = ActiveDocument.FormFields("Age")
    Set objBirthDate = ActiveDocument.FormFields("DateOfBirth")
    
    'If a valid date is entered in the BirthDate field, calculate the age.
     If IsDate(objBirthDate.Result) = False Then
      objAge.Result = ""
      GoTo Line2
     Else
     GoTo Line1
     End If
     
Line1:
     ' Find difference in calendar years.
    intYears = DateDiff("yyyy", objBirthDate.Result, datToday)
    If intYears > 0 Then
        ' Decrease by 1 if current date is earlier than birthday of current year
        ' using DateDiff to ignore a time portion of datDateOfBirth.
        intAge = intYears - Abs(DateDiff("d", datToday, DateAdd("yyyy", intYears, objBirthDate.Result)) > 0)
    End If
 
    objAge.Result = intAge
    'GoTo Line5
Line2:
    Set objAge = Nothing
    Set objBirthDate = Nothing
    
    

' check for bookmark - if it isn't there, form will close
If ActiveDocument.Bookmarks.Exists("testing") = True Then

' if bookmark exisits, it will enter the number from the form into the bookmark
If ActiveDocument.ProtectionType = wdAllowOnlyFormFields Then
ActiveDocument.Unprotect
Else

End If


Application.ScreenUpdating = False


Dim BMRange As Range
'Identify current Bookmark range and insert text
Set BMRange = ActiveDocument.Bookmarks("testing").Range

'If IsNull(ActiveDocument.Bookmarks("Age").Range.Text) Then
 If Trim(ActiveDocument.FormFields("Age").Result) = "" Then
'If ActiveDocument.Bookmarks("Age").Empty Then
 GoTo Line4
 Else: GoTo Line3
End If

Line4:
Application.ScreenUpdating = True
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
GoTo Line5

Line3:
If ActiveDocument.Bookmarks("Age").Range.Text < 16 Then
    BMRange.Text = "Children - Under 16"
    
ElseIf ActiveDocument.Bookmarks("Age").Range.Text > 15 And ActiveDocument.Bookmarks("Age").Range.Text < 25 Then
    BMRange.Text = "Transitional Youth - 16 to 24"
    
ElseIf ActiveDocument.Bookmarks("Age").Range.Text > 24 And ActiveDocument.Bookmarks("Age").Range.Text < 65 Then
    BMRange.Text = "Adults - 25 to 64"
    
ElseIf ActiveDocument.Bookmarks("Age").Range.Text > 64 Then
    BMRange.Text = "Seniors - 65+"
End If
  

'BMRange.Text = txtPHN.Text
'Re-insert the bookmark
ActiveDocument.Bookmarks.Add "testing", BMRange

'With ActiveDocument
'  .Bookmarks("HeaderPHN").Range.Delete
'  .Bookmarks("HeaderPHN").Range.Text = txtPHN.Text

Application.ScreenUpdating = True
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
'End With





End If
Line5:
    'Set objAge = Nothing
    'Set objBirthDate = Nothing
End Sub

since the value of age is no longer in a form field, I am unsure how to have this insert continue.

macropod · #7 06-27-2014, 11:14 PM

Try:

Code:

Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
Dim StrAgeRng As String
With ContentControl
  Select Case .Title
    Case "HomePhone", "CellPhone", "WorkPhone", "OtherRefererPhone", _
      "GuardianPhone", "EmergencyContactPhone", "PhysicianPhone"
      If Not .Range.Text Like "(###) ###(-)####" Then .Range.Text = Format(.Range.Text, "(###) ###-####")
    Case "PHN"
      If Not .Range.Text Like "#####(-)####" Then .Range.Text = Format(.Range.Text, "#####-####")
  Case "ApptTimeTop"
    If Not Trim(.Range.Text) Like "#########" Then .Range.Text = Format(.Range.Text, "@ #########")
  Case "DateOfBirth"
    If IsDate(ContentControl.Range.Text) Then
      ContentControl.Range.Tables(1).Cell(6, 1).Range.Paragraphs.Last.Range.Text = _
        Int(DateDiff("m", CDate(.Range.Text), Now) / 12) & ":" & DateDiff("m", CDate(.Range.Text), Now) Mod 12
      Select Case Int(DateDiff("m", CDate(.Range.Text), Now) / 12)
        Case Is < 0 > 120
          StrAgeRng = "Invalid date of birth entry!"
        Case 0 To 16
          StrAgeRng = "Children - Under 16"
        Case 16 To 24
          StrAgeRng = "Transitional Youth - 16 to 24"
        Case 25 To 64
          StrAgeRng = "Adults - 25 to 64"
        Case 64 To 119
          StrAgeRng = "Seniors - 65+"
      End Select
      ContentControl.Range.Tables(1).Cell(6, 3).Range.Paragraphs.Last.Range.Text = StrAgeRng
    End If
  End Select
End With
End Sub

Note: I've added some extra checking to prevent your phone data etc. being reformatted over and over.

kintap · #8 06-30-2014, 10:14 AM

Paul,

Thank you very much. Your help has been invaluable for this issue. You cleaning up of my code has also taught me a lot about these functioning. Thanks Again!

Kyle

kintap · #9 06-30-2014, 10:52 AM

Hi Paul,

Sorry, I hit a road block. Is there a way to make this work with grouping. I get this error if I group for the age and category now:

Run-time error '6124':
You are not allowed to edit this selection because it is protected.

Any ideas?

Kyle

macropod · #10 06-30-2014, 03:53 PM

I don't understand what you mean by 'grouping'.

The error message you're reporting suggests you've applied some form of protection to the document. Note that, unless you're actually trying to prevent editing somewhere, you don't need protection with content controls. If you do want protection, you'll need to add some content controls to the 'age' cells and the code will need a minor modification to send its output to those contents controls - the two references to:

Code:

.Paragraphs.Last.Range.Text =

will need to be changed to:

Code:

.Paragraphs.Last.Range.ContentControls(1).Range.Text =

kintap · #11 07-02-2014, 09:25 AM

Thank you Paul,

I believe you have fixed everything for me. Everything is working great, at least in my testing. Thank you again.

Kyle

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
VBA to set Content controls as non printing	Sammie0Sue	Word VBA	21	01-12-2021 04:44 PM
Content Controls in Headers	ejungk99	Word	2	06-16-2014 04:02 PM
Updating an old form with Content Controls	Something Anon	Word	4	03-26-2014 03:53 PM
Content Controls	Sammie0Sue	Word	6	11-06-2013 10:56 PM
Grouping Content Controls	cksm4	Word VBA	2	03-01-2011 12:46 PM