Hi,
I'm using VBA to unprotect a worksheet and fetch a product image and place it in 4 worksheets (in the same merged cell range in all sheets) and then protect the sheet again.
Not all the images users will be inserting have the same dimensions and I'd like the inserted image to be resized by the user if its too long for the cell range etc.
How am I able to make it so that the inserted image remains unprotected once the worksheet is protected?
I'm using VBA to unprotect a worksheet and fetch a product image and place it in 4 worksheets (in the same merged cell range in all sheets) and then protect the sheet again.
Not all the images users will be inserting have the same dimensions and I'd like the inserted image to be resized by the user if its too long for the cell range etc.
How am I able to make it so that the inserted image remains unprotected once the worksheet is protected?
VBA Code:
Sub Insert_Product_Image()
ActiveSheet.Unprotect Password:="000000"
Dim fNameAndPath As Variant
Dim img As Picture
Dim SheetsNames(), i As Long
Dim rng As Range
Dim sh As Worksheet
SheetsNames = Array("Project Pricing Calculator", "Customer Job Quote", _
"Customer Invoice", "Customer Receipt")
fNameAndPath = Application.GetOpenFilename _
("(*.gif; *.jpg; *.bmp; *.tif; *.jpeg; *.png), *.gif; *.jpg; *.bmp; *.tif; *.jpeg; *.png", _
, "Select your Product Image to Import")
If fNameAndPath = "False" Then
Sheets("Project Pricing Calculator").Protect Password:="0000002"
Exit Sub
End If
For i = LBound(SheetsNames) To UBound(SheetsNames)
Set sh = Sheets(SheetsNames(i))
'Delete the old image to put the new image
On Error Resume Next: sh.Pictures("NewPicture").Delete: On Error GoTo 0
Set rng = sh.Range("E8:G16")
Set img = sh.Pictures.Insert(fNameAndPath)
With img
.Name = "NewPicture"
'Resize image to fit in the cell range....
.ShapeRange.LockAspectRatio = msoTrue ' lock aspect ratio checkbox not selected
.Left = rng.Left
.Top = rng.Top
.Width = rng.Width
.Height = rng.Height
'Centre image in merged cells
.Top = rng.Top + (rng.Height - .Height) / 2
.Left = rng.Left + (rng.Width - .Width) / 2
.Placement = 1
.PrintObject = True
End With
Next i
ActiveSheet.Protect Password:="000000"
Worksheets("Project Pricing Calculator").Activate
End Sub