View Single Post
 
Old 06-27-2014, 11:14 PM
macropod's Avatar
macropod macropod is offline Windows 7 32bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,467
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote