Opening a jpg file

[Nasser]

Hi,

After running, error is coming and highlighting the line " For Each Pic In ActiveSheet.Pictures". It says run time error 13, type mismatch.

Private Sub CommandButton11_Click()
Dim Pic As Excel.Picture
Dim PicLocation As String
Dim MyRange As Range

Set MyRange = Range("C4")

PicLocation = "C:\Users\admc\Desktop\ctclasscurves.jpg"

For Each Pic In ActiveSheet.Pictures
If Pic.Top = MyRange.Top And Pic.Left = MyRange.Left Then
Pic.Delete
Exit For
End If
Next Pic

Set Pic = ActiveSheet.Pictures.Insert(PicLocation)

With Pic.ShapeRange
.Left = MyRange.Left
.Top = MyRange.Top
End With
End Sub

Cheers,
Nasser.

[HansV]

Which version of Excel are you using? The code runs without error for me in Excel 2003.

[Nasser]

Hi,
I have Excel 2007

Cheers,
Nasser.

[HansV]

I'll test in Excel 2007 later today. In the meantime, see if changing the line

Dim Pic As Excel.Picture

to

Dim Pic As Variant

helps.

[HansV]

I have now tested the code in Excel 2007. It works correctly whether I declare Pic as Excel.Picture, as Variant, or as Object.

[Nasser]

Hi,

1- Yes it works with Pic as variant thanks but :)...when moving the picture from its original location and then i click second time on the button, new picture will appear on C4. That would be better if only one picture appear and no more. If this is there is no solotion for this so i am quite happy with what i have now.

2- I want to delete the picture but not from the keyboard. I am putting a second button to delete the picture. I tried this code:

Private Sub CommandButton12_Click()
Dim PicLocation As String
PicLocation = "C:\Users\admc\Desktop\ctclasscurves.jpg"
PicLocation.Select
Selection.Delete
End Sub

I tried other ways but still not working

I appreciate your help,

Cheers,
Nasser.

[HansV]

PicLocation is a string, not a picture. You can't select or delete a string.

The following code will remove ALL pictures from the sheet:

Code: Select all

Sub RemovePictures()
  Dim i As Integer
  For i = ActiveSheet.Pictures.Count To 1 Step -1
    ActiveSheet.Pictures(i).Delete
  Next i
End Sub

You can then change the InsertPicture macro as follows:

Code: Select all

Sub InsertPicture()
  Dim Pic As Excel.Picture
  Dim PicLocation As String
  Dim MyRange As Range

  ' Remove ALL pictures
  Call RemovePictures

  Set MyRange = Range("C4")
  PicLocation = "C:\Users\admc\Desktop\ctclasscurves.jpg"
  Set Pic = ActiveSheet.Pictures.Insert(PicLocation)

  With Pic.ShapeRange
    .Left = MyRange.Left
    .Top = MyRange.Top
  End With
End Sub

[Nasser]

Hi,

Last question to close the subject. When i run the program above, the button got removed along with the pictures.

Cheers,
Nasser.

[HansV]

Do you use a picture as a button?
Ack! A command button from the Control Toolbox counts as a picture too...
I'll see if I can think of an alternative.

[Nasser]

Hi,

Exact, it's why it is getting removed as well.
My wish, one button to display the picture and the second button to remove the picture. That will be nice :).

Thanks and Regards
Nasser.

[HansV]

Try this code. The InsertPicture can be used for a button to insert the picture (and it prevents the same picture from being inserted more than once), and the RemovePicture macro can be used for a button to remove the picture. The code will leave all other pictures alone, including command buttons.

Code: Select all

Const PicName = "ctcclasscurves"

Sub InsertPicture()
  Dim Pic As Excel.Picture
  Dim PicLocation As String
  Dim MyRange As Range

  Call RemovePicture

  Set MyRange = Range("C4")
  PicLocation = "C:\Users\admc\Desktop\ctclasscurves.jpg"
  Set Pic = ActiveSheet.Pictures.Insert(PicLocation)
  Pic.Name = PicName

  With Pic.ShapeRange
    .Left = MyRange.Left
    .Top = MyRange.Top
  End With
End Sub

Sub RemovePicture()
  On Error Resume Next
  ActiveSheet.Pictures(PicName).Delete
  On Error GoTo 0
End Sub

[Nasser]

FANTASTIC

I added the statement where i click more than one time i get only one picture and not one on top of other which you have added it in the previous conversation. Now the 2 buttons are working as i wanted. Great job Hans.

Here is the final code: 1 button to insert the picture, second button to remove the picture.

Option Explicit

Const PicName = "ctcclasscurves"

Private Sub InsertPicture_Click()
Dim Pic As Variant
Dim PicLocation As String
Dim MyRange As Range

Set MyRange = Range("C4")
PicLocation = "C:\Users\admc\Desktop\ctclasscurves.jpg"

For Each Pic In ActiveSheet.Pictures
If Pic.Top = MyRange.Top And Pic.Left = MyRange.Left Then
Pic.Delete
Exit For
End If
Next Pic

Set Pic = ActiveSheet.Pictures.Insert(PicLocation)
Pic.Name = PicName

With Pic.ShapeRange
.Left = MyRange.Left
.Top = MyRange.Top
End With
End Sub

Private Sub RemovePicture_Click()
On Error Resume Next
ActiveSheet.Pictures(PicName).Delete
On Error GoTo 0
End Sub

Many Thanks Hans,
Cheers,
Nasser.

[Nasser]

Now i have to go back to my fuse and relay which are giving me hard time

I am trying to avoid the subroutines and try to program it using only one sub, play with the "if and for" and see how it works

Cheers,
Nasser.

[HansV]

Good luck!

[ChrisGreaves]

... this function will create a direct hyperlink to those files:

Thanks Jan karel.
You just made me look good.
Again!

[Nasser]

Hi,

A long time back we have discussed about opening a picture in excel. The code you have shown it to me was:

Private Sub CommandButton1_Click()
Dim Pic As Excel.Picture
Dim PicLocation As String
Dim MyRange As Range

Set MyRange = Range("c4")

PicLocation = "C:\Users\admc\Desktop\LatexFigures\fuse\HRC1.jpg"

For Each Pic In ActiveSheet.Pictures
If Pic.Top = MyRange.Top And Pic.Left = MyRange.Left Then
Pic.Delete
Exit For
End If
Next Pic

Set Pic = ActiveSheet.Pictures.Insert(PicLocation)

With Pic.ShapeRange
.Left = MyRange.Left
.Top = MyRange.Top
End With
End Sub

It gives me an error when i click on the button to display the picture.

What could be the problem?

Many thanks,
Nasser.

[HansV]

What does the error message say?

[Nasser]

Hi Hans,

It says: Run-time error '13'
Type mismatch

when i click on debug the arrow point - out on the line:

"For Each Pic In ActiveSheet.Pictures" and get highlighted in yellow

Regards,
Nasser

[HansV]

I cannot reproduce the error but does this version work better?

Code: Select all

Private Sub CommandButton1_Click()
  Dim shp As Shape
  Dim pic As Picture
  Dim PicLocation As String
  Dim MyRange As Range

  Set MyRange = Range("C4")

  PicLocation = "C:\Users\admc\Desktop\LatexFigures\fuse\HRC1.jpg"

  For Each shp In ActiveSheet.Shapes
    If shp.Top = MyRange.Top And shp.Left = MyRange.Left Then
      shp.Delete
      Exit For
    End If
  Next shp

  Set pic = ActiveSheet.Pictures.Insert(PicLocation)

  With pic.ShapeRange
    .Left = MyRange.Left
    .Top = MyRange.Top
  End With
End Sub

[Nasser]

Hi,

That is working fine now, many thanks.

Two things and i am done with this work.

1- After opening the picture, i want to delete it using another button. I tried this code but it does not work

Private Sub CommandButton2_Click()
Dim shp As Shape
ActiveSheet.Shapes
shp.Delete
End Sub

2- After protecting my sheet and run it, the error is coming and poiting out this line after trying to open it:

Set pic = ActiveSheet.Pictures.Insert(PicLocation)

Many thanks,
Nasser.