Click here to Skip to main content
13,006,195 members (74,980 online)
Rate this:
Please Sign up or sign in to vote.
See more:

I have written the below code for capturing the excel content as image, adding new sheet in excel and pasting the image in added new sheet.
Earlier my code for capturing the image was working but now its giving some error. Please let me know the error as i am unable to identify it.
Also the code is creating chart in the image but i dont want the chart.

' To copy content as image
Sub Export_Range_Images()
Dim oRange As Range
Dim oCht As Chart
Dim oImg As Picture
Set oRange = Range("A1:I84")
Set oCht = Charts.Add
Set oImg = Picture.Add
oCht.Export Filename:="E:\img\SavedRange.jpg", Filtername:="JPG"
End Sub
' To add new sheet
Sub AddSheet()
Dim ActNm As String
With ActiveWorkbook.Sheets
.Add after:=Worksheets(Worksheets.Count)
End With
ActNm = ActiveSheet.Name
On Error Resume Next
ActiveSheet.Name = "Jul 16 2012"
NoName: If Err.Number = 1004 Then ActiveSheet.Name = InputBox("Give name.")
If ActiveSheet.Name = ActNm Then GoTo NoName
On Error GoTo 0
End Sub
'Code to paste image in newly added sheet
Sub TestInsertPictureInRange()
InsertPictureInRange "E:\img\SavedRange.jpg", _
End Sub
Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
' inserts a picture and resizes it to fit the TargetCells range
Dim p As Object, t As Double, l As Double, w As Double, h As Double
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
If Dir(PictureFileName) = "" Then Exit Sub
' import picture
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
' determine positions
With TargetCells
t = .Top
l = .Left
w = .Offset(0, .Columns.Count).Left - .Left
h = .Offset(.Rows.Count, 0).Top - .Top
End With
' position picture
With p
.Top = t
.Left = l
.Width = w
.Height = h
End With
Set p = Nothing
End Sub
/*Calling all macros*/
Sub All_codes()
End Sub

Posted 15-Aug-12 5:10am
Updated 15-Aug-12 5:11am
Wes Aday 15-Aug-12 11:14am
"giving some error"... and that error would be what? Are we supposed to guess?
archies_gall 17-Aug-12 0:19am
Run-time error '424':
Object required

This information box i am getting when it reaches the line:
Set oImg = Picture.Add

in Export_Range_Images() macro.

I am not sure how to attach a screen shot here....
Hope this helps you to understand my problem.
Wes Aday 17-Aug-12 7:49am
You are getting that error probably because Picture is Nothing
Sergey Alexandrovich Kryukov 15-Aug-12 13:16pm
I'm curious why would you ever need it. By the way, if you explain, it will give you some chance that someone bothers to answer, otherwise -- hardly.
And then explain the problem properly. Error or exception? Provide comprehensive information. In what line, etc.
Anonimista 16-Aug-12 13:44pm
I've yet to see a VBA procedure throw an exception.

1 solution

Rate this: bad
Please Sign up or sign in to vote.

Solution 1

The most important thing is that the code is not optimised! What it means?

1) if the part of procedure is used more than one time, you need to use this as a separatly function/procedure or to send it as a parameter!
The procedures TestInsertPictureInRange and Export_Range_Images should have as an input parameter the name of image, as you use it in InsertPictureInRange procedure.

Sub TestInsertPictureInRange (ByVal PictureFileName AS String)
End Sub
Sub Export_Range_Images (ByVal PictureFileName AS String)
End Sub

2) if the code has no context, the effect of its job can bring unexpected results!
For example, try to run this procedure:
Sub Test
Range("A1") = "Hello Kitty!"
End Sub

for 3 opened workbooks and for each sheet in them.

Please, see my code (with error-handler):
Option Explicit
Sub Test()
    InsertImageInRange "F:\Download\Saalbach009.jpg", Format(Date, "yyyyMMdd")
    InsertImageInRange "F:\Download\Saalbach009.jpg", Format(Date, "yyyyMMdd"), "A1:I29"
End Sub
'Code to insert a picture/image in the current/active workbook into newly added sheet
' and resizes it to fit the TargetCells range
Sub InsertImageInRange(ByVal PictureFileName As String, ByVal DefaultSheetName As String, Optional ByVal DefaultTargetRange As String = "G10:N30")
Dim wsh As Worksheet, rng As Range, pic As Shape
'On error go to error-handler
On Error GoTo Err_ExportRangeAsImage
Set wsh = ActiveWorkbook.Worksheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
wsh.Name = DefaultSheetName
Set rng = wsh.Range(DefaultTargetRange)
Set pic = wsh.Shapes.AddPicture(PictureFileName, msoFalse, msoCTrue, rng.Left, rng.Top, _
                rng.Offset(0, rng.Columns.Count).Left - rng.Left, rng.Offset(rng.Rows.Count, 0).Top - rng.Top)

    On Error Resume Next
    Set wsh = Nothing
    Set rng = Nothing
    Set pic = Nothing
    Exit Sub
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_ExportRangeAsImage
End Sub

More you'll find at:[^][^][^]
Sandeep Mewara 24-Aug-12 14:19pm
My 5 for detailed effort!
losmac 24-Aug-12 14:22pm
Thank you Sandeep ;)

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

  Print Answers RSS
Top Experts
Last 24hrsThis month

Advertise | Privacy | Mobile
Web01 | 2.8.170628.1 | Last Updated 17 Sep 2012
Copyright © CodeProject, 1999-2017
All Rights Reserved. Terms of Service
Layout: fixed | fluid

CodeProject, 503-250 Ferrand Drive Toronto Ontario, M3C 3G8 Canada +1 416-849-8900 x 100