Follow

Keep Up to Date with the Most Important News

By pressing the Subscribe button, you confirm that you have read and are agreeing to our Privacy Policy and Terms of Use
Contact

Inserting an existing photo from file

I want to add an image to a specific cell on active sheet. The image should fit the cell. I found a piece of code which works perfectly but I get an error message when the sheet is protected. I have to keep the sheet protected with the object editing unchecked before sharing the file with my coworkers.

How can I overcome this problem?

The code I use:

MEDevel.com: Open-source for Healthcare and Education

Collecting and validating open-source software for healthcare, education, enterprise, development, medical imaging, medical records, and digital pathology.

Visit Medevel

Sub AddPhoto()
    Dim strFileName As String
    Dim objPic As Picture
    Dim rngDest As Range
    strFileName = Application.GetOpenFilename( _
        FileFilter:="Images (*.jpg;*.gif;*.png),*.jpg;*.gif;*.png", _
        Title:="Please select an image...")
    If strFileName = "False" Then Exit Sub
    Set rngDest = Worksheets(ActiveSheet.Name).Range("A10:D20")
    Set objPic = Worksheets(ActiveSheet.Name).Pictures.Insert(strFileName)
    With objPic
        .ShapeRange.LockAspectRatio = msoFalse
        .Left = rngDest.Left
        .Top = rngDest.Top
        .Width = rngDest.Width
        .Height = rngDest.Height
    End With
End Sub

>Solution :

Unprotect at the start of your code, and re-protect at the end.

One way or another, the destination range can’t be protected if you want to put an image in it.
(That’s what protection is protecting against.)

Add a comment

Leave a Reply

Keep Up to Date with the Most Important News

By pressing the Subscribe button, you confirm that you have read and are agreeing to our Privacy Policy and Terms of Use

Discover more from Dev solutions

Subscribe now to keep reading and get access to the full archive.

Continue reading