Try the following:
Code:
Option Explicit
Dim i As Long
Private Type ListData
strsizey As String
strsizex As String
End Type
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
Dim Doc As Document, tData As ListData, cellCC As ContentControl, officeCC As ContentControl
Dim faxCC As ContentControl, rowRange As Range
Set Doc = ContentControl.Parent
If Application.Version < "14.0" Then Main.SetDeveloperTabActive
If ContentControl.Tag = "SizeSeries" Then
tData = GetDataIII(ContentControl)
With Doc.SelectContentControlsByTitle("SizeY").Item(1)
.LockContents = False
.Range.Text = tData.strsizey
.LockContents = True
End With
With Doc.SelectContentControlsByTitle("SizeX").Item(1)
.LockContents = False
.Range.Text = tData.strsizex
.LockContents = True
End With
ElseIf ContentControl.Type = wdContentControlDropdownList Then
If InStr(ContentControl.Title, "Project Manager") > 0 Then
Set rowRange = ContentControl.Range.Rows(1).Range
Set officeCC = GetOfficeCCforRow(rowRange, "PhoneOffice")
Set cellCC = GetOfficeCCforRow(rowRange, "PhoneCell")
Set faxCC = GetOfficeCCforRow(rowRange, "PhoneFax")
Select Case ContentControl.Range.Text
Case "User1"
officeCC.Range.Text = "User1 office"
cellCC.Range.Text = "User1 cell"
faxCC.Range.Text = "User1 fax"
Case "User2"
officeCC.Range.Text = "User2 office"
cellCC.Range.Text = "User2 cell"
faxCC.Range.Text = "User2 fax"
Case "User3"
officeCC.Range.Text = "User3 office"
cellCC.Range.Text = "User3 cell"
faxCC.Range.Text = "User3 fax"
End Select
End If
End If
End Sub
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
Dim Doc As Word.Document
Set Doc = ContentControl.Parent
If ContentControl.Type = wdContentControlDropdownList Then
If InStr(ContentControl.Title, "Project Manager") <> 0 Then
Dim cellCC As Word.ContentControl
Dim officeCC As Word.ContentControl
Dim faxCC As Word.ContentControl
Dim rowRange As Word.Range
Set rowRange = ContentControl.Range.Rows(1).Range
Set officeCC = GetOfficeCCforRow(rowRange, "PhoneOffice")
Set cellCC = GetOfficeCCforRow(rowRange, "PhoneCell")
Set faxCC = GetOfficeCCforRow(rowRange, "PhoneFax")
Select Case ContentControl.Range.Text
Case "User1"
officeCC.Range.Text = "User1 office"
cellCC.Range.Text = "User1 cell"
faxCC.Range.Text = "User1 fax"
Case "User2"
officeCC.Range.Text = "User2 office"
cellCC.Range.Text = "User2 cell"
faxCC.Range.Text = "User2 fax"
Case "User3"
officeCC.Range.Text = "User3 office"
cellCC.Range.Text = "User3 cell"
faxCC.Range.Text = "User3 fax"
End Select
End If
End If
End Sub
Private Function GetOfficeCCforRow(rng, ccTitle) As Word.ContentControl
Dim ccs As Word.ContentControls
Dim cc As Word.ContentControl
Dim ccFound As Word.ContentControl
Set ccs = rng.Parent.SelectContentControlsByTag(ccTitle)
For Each cc In ccs
If cc.Range.InRange(rng.Cells(2).Range) Then
Set ccFound = cc
End If
Next
Set GetOfficeCCforRow = ccFound
End Function
Private Function GetDataIII(ByRef oCCPassed) As ListData
Dim arrData() As String
For i = 1 To oCCPassed.DropdownListEntries.Count
If oCCPassed.Range.Text = oCCPassed.DropdownListEntries(i).Text Then
arrData() = Split(oCCPassed.DropdownListEntries(i).Value, "|")
Exit For
End If
Next i
On Error GoTo Err_NoPick
GetDataIII.strsizey = arrData(0)
GetDataIII.strsizex = arrData(1)
Exit Function
Err_NoPick:
GetDataIII.strsizey = ""
GetDataIII.strsizex = ""
lbl_Exit:
Exit Function
End Function
PS: When posting code, please use the code tags. They're on the 'Go Advanced' tab.