Load image in Content Control based on drop down list selection

[BradBerger]

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!

[BradBerger]

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!

[BradBerger]

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.



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

[EimearC]

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?
30984
Edit: I have added the coding used here in case I have done something wrong:


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

[gmayor]

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

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

[EimearC]

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?

[gmaxey]

You might try:

oCC.LockContents = False