CODEWITHSUNDEEP
imagevbaexcelexport
Snor Neel
Snor Neel

Reputation: 51

Export range as image

For a while now, my colleagues and me have been using all kinds of methods to create a template to easily make volunteer vacancy forms.

Ideally, the person in charge of said project should only input details and the vacancy form is generated automatically.

At this point, I got as far as having the form completed automatically, but we still have to copy the range and paste it into paint manually to save it as an image. Also at the top en left side of the image, there's still a very thin space of white left that we have to adjust.

So my two questions: what code will bring me succes in achieving both the exporting a range (A1:F19) as image (format doesn't matter to me, unless you guys see (dis)advantages in any), and that the thin white space gets corrected?

It would be ideal if the image would be saved in the same folder as from where the code is being executed and the file name would be that of cell J3.

I've been trying several macro's I found both here and on other sites, but was unable to make any work, but this one seemed most logic/pragmatic to me - credits to Our Man In Bananas; Using VBA Code how to export excel worksheets as image in Excel 2003?:

dim sSheetName as string
dim oRangeToCopy as range
Dim oCht As Chart

sSheetName ="Sheet1" ' worksheet to work on
set  oRangeToCopy =Range("B2:H8") ' range to be copied

Worksheets(sSheetName).Range(oRangeToCopy).CopyPicture xlScreen, xlBitmap
set oCht =charts.add

with oCht
    .paste
    .Export FileName:="C:\SavedRange.jpg", Filtername:="JPG"
end with

Hi! thanks for your answer! So I altered the code slightly, because a file without extension was beaing created, and a little bit of white space was left at the top and left of the image. This is the result:

Sub Tester()
    Dim sht As Worksheet
    Set sht = ThisWorkbook.Worksheets("Activiteit")

    ExportRange sht.Range("A1:F19"), _
                ThisWorkbook.Path & "\" & sht.Range("J3").Value & ".png"

End Sub


Sub ExportRange(rng As Range, sPath As String)

    Dim cob, sc

    rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    Set cob = rng.Parent.ChartObjects.Add(0, 0, 200, 200)
    'remove any series which may have been auto-added...
    Set sc = cob.Chart.SeriesCollection
    Do While sc.Count > 0
        sc(1).Delete
    Loop

    With cob
        .Height = rng.Height
        .Width = rng.Width
        .Chart.Paste
        .Chart.Export FileName:=sPath, Filtername:="PNG"
        .Delete
    End With

End Sub

Now it's perfect except for one small details; the image now has a (very, very) thin gray border around it. It's not that big that it's really an issue, only trained eyes would notice it. If there's no way to get rid of it - no biggie. But just in case, if you'd know a way that would be absolutely great.

I've tried by changing the values in this line

Set cob = rng.Parent.ChartObjects.Add(0, 0, 200, 200)

to -10, but that didn't seem to help.

Upvotes: 3

Views: 11706

Answers (2)

Tim Williams
Tim Williams

Reputation: 166126

Added a line to remove the border from around the chartobject

Sub Tester()
    Dim sht as worksheet
    Set sht = ThisWorkbook.Worksheets("Sheet1")

    ExportRange sht.Range("B2:H8"), _
                ThisWorkbook.Path & "\" & sht.Range("J3").Value

End Sub


Sub ExportRange(rng As Range, sPath As String)

    Dim cob, sc

    rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    Set cob = rng.Parent.ChartObjects.Add(10, 10, 200, 200)
    'remove any series which may have been auto-added...
    Set sc = cob.Chart.SeriesCollection
    Do While sc.Count > 0
        sc(1).Delete
    Loop

    With cob
        .ShapeRange.Line.Visible = msoFalse  '<<< remove chart border
        .Height = rng.Height
        .Width = rng.Width
        .Chart.Paste
        .Chart.Export Filename:=sPath, Filtername:="PNG"
        .Delete
    End With

End Sub

Upvotes: 3

Dag
Dag

Reputation: 11

I have been using this a few months, but after upgrading to windows 10 / excel 2016, the export is a blank image. And found that Excel 2016 is a bit slowminded and need everything bit by bit... the with... section should not contain the delete method and the chart need to be activated before paste...

like this:

mychart.Activate
 With mychart
    .Height = rng.Height
        .Width = rng.Width
        .Chart.Paste
        .Chart.Export Filename:=strTempfile, Filtername:="PNG"      
    End With
mychart.Delete

Upvotes: 1

Related Questions