View Single Post
 
Old 11-12-2013, 01:40 AM
macropod's Avatar
macropod macropod is offline Windows 7 32bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,343
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 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.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote