dynamically display pictures

[gleamng]

Greetings to you all.

I have a workbook with list of clients and their details in sheet (index), while every client has a sheet each, on every sheet i want picture of every client to appear on his/her.

i got the below code online, but it only works if the sheets were un-protected, and i need to protect the sheets. pls kindly help me out, here comes the vba code

Option Explicit

Function InsertPictureInCell(rg As Range, FilePathName As String) As String
Dim ws As Worksheet
Dim sh As Shape, objPicture As Object
Dim PictureExists As Integer
Dim PictureLeftPosition As Single, PictureTopPosition As Single
Dim PictureWidth As Single, PictureHeight As Single, Aspect As Single
    
    Application.ScreenUpdating = False
    Set ws = ThisWorkbook.Worksheets(rg.Worksheet.Name)
    PictureExists = 0
    If ws.Shapes.Count > 0 Then
        For Each sh In ws.Shapes
            If sh.TopLeftCell.Column = rg.Column And sh.TopLeftCell.Row = rg.Row Then
                PictureExists = 1
            End If
        Next sh
    End If
    If PictureExists = 0 Then
        If Dir(FilePathName) <> "" Then
            If LCase(Right(FilePathName, 3)) = "jpg" Or LCase(Right(FilePathName, 3)) = "tif" Then
                Set objPicture = ws.Pictures.Insert(FilePathName)
                Aspect = objPicture.Width / objPicture.Height
                objPicture.Delete
            Else
                Set objPicture = LoadPicture(FilePathName)
                Aspect = objPicture.Width / objPicture.Height
            End If
                
            PictureTopPosition = rg.Top + 1
            PictureLeftPosition = rg.Left + 1
            PictureHeight = rg.Height + 90
            PictureWidth = PictureHeight * Aspect
            ws.Shapes.AddPicture FilePathName, msoFalse, msoTrue, PictureLeftPosition, PictureTopPosition, PictureWidth, PictureHeight
            InsertPictureInCell = ""
        Else
            InsertPictureInCell = "No file"
        End If
    Else
        InsertPictureInCell = ""
    End If
    Application.ScreenUpdating = True
End Function

 

[Domenic]

Simply add a line of code to unprotect your sheet before the the changes to your worksheet are made, and then another line of code to protect the your sheet afterwards, for example...

ws.Unprotect Password:="Your PassWord"
[COLOR=#008000]'Your code to make changes here
'
'[/COLOR]
ws.Protect Password:="Your PassWord"

Note that a password is optional.