#1
|
|||
|
|||
Calculate Age From Content Controls
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. |
#2
|
||||
|
||||
I am unable to open your document after renaming. perhaps you could add it to a zip archive and upload that.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
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. |
#4
|
||||
|
||||
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
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
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 |
#6
|
|||
|
|||
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 |
#7
|
||||
|
||||
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
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#8
|
|||
|
|||
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 |
#9
|
|||
|
|||
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 |
#10
|
||||
|
||||
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 = Code:
.Paragraphs.Last.Range.ContentControls(1).Range.Text =
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#11
|
|||
|
|||
Thank you Paul,
I believe you have fixed everything for me. Everything is working great, at least in my testing. Thank you again. Kyle |
Tags |
age;content control |
|
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 |