Load image in Content Control based on drop down list selection

Is there a way to load an image in a picture content control based on the selection of a drop down list? The image would just be in a basic location like My Pictures. The path isnt too important as I can always change that.

Thanks!

Thanks for the reply. I just tried this out and it isnt inserting the image in the rich text CC. I made sure the image path is correct as well. How does the code know which item has been selected in the drop down list? Should it be looking for the display name of each item or the value?

Edit: I jumped the gun. I didnt realize that I needed to put the name of each item as the case. It's working now!

I may not be out of the woods yet. There's alot going on in the ContentControlOnExit sub and I've added your code to it as well. Every time I click on the rich text CC that the picture is being inserted into, I'm getting a run time error 5991: Cannot access individual rows in this collection because the table has vertically merged cells. There are 11 tables in this document so I'm not sure which one this error is referring to. Here's the entire OnExit code. I apologize if it's sloppy, I havent being doing this sort of stuff for very long.

Code:

---

Private Sub Document_ContentControlOnExit(ByVal CC As ContentControl, Cancel As Boolean)
Dim oCC As ContentControl
Dim Index As Long
Dim oCell As Cell
Dim lngRow As Long
Dim sName1 As String, sName2 As String, sName3 As String
       
    lngRow = CC.Range.Rows(1).Index
    sName1 = "Qty" & lngRow
    sName2 = "Amount" & lngRow
    sName3 = "Total" & lngRow
       
On Error GoTo Err_Handler
Select Case CC.Tag
  Case "Phone"
    If IsNumeric(CC.Range.Text) Then
      CC.Range.Text = Format(CC.Range.Text, "(000) 000-0000")
    End If
  Case sName1
    If Not IsNumeric(CC.Range.Text) Then
      Cancel = True
      Beep
      CC.Range.Select
      Exit Sub
    Else
      CC.Range.Text = FormatValue(CC.Range.Text)
    End If
  Case sName2
    If IsNumeric(CC.Range.Text) Then
      CC.Range.Text = FormatCurrency(CC.Range.Text)
    End If
    Set oCC = ActiveDocument.SelectContentControlsByTag(sName3).Item(1)
    With oCC
      .LockContents = False
      .Range.Text = FormatCurrency(ProductAB(ActiveDocument.SelectContentControlsByTag(sName1).Item(1).Range.Text, ActiveDocument.SelectContentControlsByTag(sName2).Item(1).Range.Text))
      .LockContents = True
    End With
    Set oCC = ActiveDocument.SelectContentControlsByTag("PartsTotal").Item(1)
    With oCC
      .LockContents = False
      .Range.Text = FormatCurrency(ActiveDocument.SelectContentControlsByTag("Total" & lngRow).Item(1).Range.Text)
      .LockContents = True
    End With
    Set oCC = ActiveDocument.SelectContentControlsByTag("JETotal").Item(1)
    With oCC
      .LockContents = False
      .Range.Text = FormatCurrency(MathAdd(ActiveDocument.SelectContentControlsByTag("HoursWorkedTotal").Item(1).Range.Text, ActiveDocument.SelectContentControlsByTag("MileageTotal").Item(1).Range.Text, ActiveDocument.SelectContentControlsByTag("PartsTotal").Item(1).Range.Text))
      .LockContents = True
    End With
  Case "RateHoursWorked"
    Set oCC = ActiveDocument.SelectContentControlsByTag("RateHoursWorked").Item(1)
    With oCC
      .LockContents = False
    If IsNumeric(CC.Range.Text) Then
      CC.Range.Text = FormatCurrency(CC.Range.Text)
    End If
      .LockContents = True
    End With
  Case "MileageRate"
    Set oCC = ActiveDocument.SelectContentControlsByTag("MileageRate").Item(1)
    With oCC
      .LockContents = False
    If IsNumeric(CC.Range.Text) Then
      CC.Range.Text = FormatCurrency(CC.Range.Text)
    End If
      .LockContents = True
    End With
End Select


    If CC.Tag <> "Engineer" Then Exit Sub
    With ActiveDocument.SelectContentControlsByTag("EngineerSig")(1).Range
        Do While .InlineShapes.Count > 0
            .InlineShapes(1).Delete
        Loop
        Select Case CC.Range.Text
        Case "Brad Berger": .InlineShapes.AddPicture FileName:="C:\Users\" & Environ("UserName") & "\Pictures\sig.png"
        Case Else
        End Select
    End With


Err_ReEntry:
Set oCC = Nothing
Exit Sub
Err_Handler:
  With oCC
    .LockContents = False
    Beep
    .Range.Text = "ERROR"
    .LockContents = True
  End With
Resume Err_ReEntry
End Sub

---

Hi, I apologise for opening an old thread but I am using the above VBA code to change a picture based on a drop down list content control selection but I keep getting an error, please see picture below. There is no restrictions on this document so I am not sure what the error means, would anyone be able to assist me please?
Attachment 30984
Edit: I have added the coding used here in case I have done something wrong:

Code:

---

Private Sub Document_ContentControlOnExit(ByVal CCtrl As ContentControl, Cancel As Boolean)
If CCtrl.Title <> "Companies" Then Exit Sub
With ActiveDocument.SelectContentControlsByTitle("Picture")(1).Range
  Do While .InlineShapes.Count > 0
    .InlineShapes(1).Delete
  Loop
  Select Case CCtrl.Range.Text
    Case "company1": .InlineShapes.AddPicture FileName:="C:\Users" & Environ("UserName") & "\Pictures\pic1.JPG"
    Case "company2": .InlineShapes.AddPicture FileName:="C:\Users" & Environ("UserName") & "\Pictures\pic2.JPG"
    Case "company3": .InlineShapes.AddPicture FileName:="C:\Users" & Environ("UserName") & "\Pictures\pic3.png"
    Case Else
  End Select
End With
End Sub

---

Your path is wrong, and the macro gets confused about which range is being processed. Try the following

Code:

---

Private Sub Document_ContentControlOnExit(ByVal CCtrl As ContentControl, Cancel As Boolean)
Dim oCC As ContentControl
    Set oCC = ActiveDocument.SelectContentControlsByTitle("Picture")(1)
    If CCtrl.Title <> "Companies" Then Exit Sub
    With oCC.Range
        Do While .InlineShapes.Count > 0
            .InlineShapes(1).Delete
        Loop
    End With
    Select Case CCtrl.Range.Text
        Case "company1": oCC.Range.InlineShapes.AddPicture FileName:="C:\Users\" & Environ("UserName") & "\Pictures\pic1.JPG"
        Case "company2": oCC.Range.InlineShapes.AddPicture FileName:="C:\Users\" & Environ("UserName") & "\Pictures\pic2.JPG"
        Case "company3": oCC.Range.InlineShapes.AddPicture FileName:="C:\Users\" & Environ("UserName") & "\Pictures\pic3.png"
        Case Else
    End Select
End Sub

---

Hi Graham,

Thanks so much for getting back to me, I have updated the macro with your code but unfortunately I am still getting the same error, that 'the current selection is locked for editing'. Any ideas?

You might try:

oCC.LockContents = False