Insert Image in cell B13 on Protected worksheet

  • Thread starter Thread starter Manuel
  • Start date Start date
M

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
 
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 >
 
Back
Top