Insert Image in cell B13 on Protected worksheet

[Manuel]

Hi, i need help! i want to put an image, selected by the user, in cel
B13...the worksheet is protected...

i used to use this code:

Private Sub CommandButton4_Click()

Dim Pict
Dim ImgFileFormat As String
Dim PictCell As Range
Dim Ans As Integer

ImgFileFormat = "Imagens Jpg (*.jpg),others, Bmp (*.bmp),*.bmp, Gi
(*.gif),*.gif"

GetPict:
Pict = Application.GetOpenFilename(ImgFileFormat)
If Pict = False Then End

Ans = MsgBox("Open : " & Pict, vbYesNo, "Insert Picture")
If Ans = vbNo Then GoTo GetPict

Sheets("Ficha Técnica").Unprotect (1111111)
GetCell:
Set PictCell = Application.InputBox("Inserir este valor -> B:13 "
Type:=8)
If PictCell.Count > 1 Then MsgBox "Seleccionar uma célula": GoT
GetCell
PictCell.Select
ActiveSheet.Pictures.Insert(Pict).Select
If PictCell = vbCancel Then GoTo GetCell
Sheets("Ficha Técnica").Protect (1111111), False, True, True

but i want to make this quicker...i want to change the part i
italic...after i select the image paste the image in cell B13...

sorry for my english...i hope you can help me...thank

 

[keepitcool]

Manuel?

Wouldn't following be simpler?

Sub GetThePicture()
Dim shp As ShapeRange
SetProtect False
[b13].Select
Application.Dialogs(xlDialogInsertPicture).Show
If TypeName(Selection) = "Picture" Then
Set shp = Selection.ShapeRange
With shp
.Height = 50
.Width = 100
End With
End If
SetProtect True

End Sub

Sub SetProtect(blnOnOff As Boolean)
Const PW = "password"
If blnOnOff Then ActiveSheet.Protect PW Else ActiveSheet.Unprotect PW
End Sub



keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >