3

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.

Community
  • 1
  • 1
Snor Neel
  • 51
  • 1
  • 1
  • 10

2 Answers2

3

EDIT: 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
Tim Williams
  • 154,628
  • 8
  • 97
  • 125
  • Hi Tim! Thanks a lot! I've added a small bit to my question, I was wondering if you would be so kind as to take a look at it? – Snor Neel Apr 28 '17 at 03:27
  • i don't know how you'd get rid of the border - you could try modifying the cell borders on the range being copied... – Tim Williams Apr 28 '17 at 03:42
  • That works to remove the border indeed, but now there's a white (blank) border around the image... it's odd, because there's no such thing in the original file and the macro captures the sheet like shown on the screen right? Is there some code that crops images? Because tha'ts probably the easiest solution - just cutting out the border? – Snor Neel Apr 29 '17 at 11:13
1

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
jcubic
  • 61,973
  • 54
  • 229
  • 402
Dag
  • 11
  • 2