Click here to Skip to main content
Rate this: bad
good
Please Sign up or sign in to vote.
See more: VBA
Hello,

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.Paste
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", _
Range("A1:I84")
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()
Export_Range_Images
AddSheet
TestInsertPictureInRange
End Sub

 
Thanks!
Archie
Posted 15-Aug-12 5:10am
Edited 15-Aug-12 5:11am
v2
Comments
Wes Aday at 15-Aug-12 11:14am
   
"giving some error"... and that error would be what? Are we supposed to guess?
archies_gall at 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 at 17-Aug-12 7:49am
   
You are getting that error probably because Picture is Nothing
Sergey Alexandrovich Kryukov at 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. --SA
Anonimista at 16-Aug-12 13:44pm
   
I've yet to see a VBA procedure throw an exception.

1 solution

Rate this: bad
good
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)
 

Exit_ExportRangeAsImage:
    On Error Resume Next
    Set wsh = Nothing
    Set rng = Nothing
    Set pic = Nothing
    Exit Sub
 
Err_ExportRangeAsImage:
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_ExportRangeAsImage
 
End Sub
 
More you'll find at:
http://www.jpsoftwaretech.com/export-excel-range-to-a-picture-file/[^]
http://dmcritchie.mvps.org/excel/xl2gif.htm[^]
http://www.ozgrid.com/forum/showthread.php?t=65781[^]
  Permalink  
v2
Comments
Sandeep Mewara at 24-Aug-12 14:19pm
   
My 5 for detailed effort!
losmac at 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
Your Filters
Interested
Ignored
     
0 Sergey Alexandrovich Kryukov 515
1 OriginalGriff 468
2 Abhinav S 305
3 sanket saxena 295
4 Tadit Dash 160
0 Sergey Alexandrovich Kryukov 8,482
1 OriginalGriff 4,830
2 Peter Leow 3,794
3 Maciej Los 3,515
4 Er. Puneet Goel 3,107


Advertise | Privacy | Mobile
Web02 | 2.8.140415.2 | Last Updated 17 Sep 2012
Copyright © CodeProject, 1999-2014
All Rights Reserved. Terms of Use
Layout: fixed | fluid