VBA - saving an image by exporting a chart as png leaves gray image border

[Taisho]

the code is:

Sub mapsave()

Dim pic_rng As Range
Dim ShTemp As Worksheet
Dim ChTemp As Chart
Dim PicTemp As Picture
Dim FName As String

FName = "C:\Users\Rychu\Desktop\Temperatures.png"
    
Application.ScreenUpdating = False

ThisWorkbook.Windows(1).DisplayGridlines = False

Set pic_rng = Worksheets("map").Range("A1:k32")
Set ShTemp = Worksheets.Add
Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:=ShTemp.Name
Set ChTemp = ActiveChart
pic_rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        
With ThisWorkbook.Sheets("map")
    ActiveSheet.Shapes.Item(1).Line.Visible = msoFalse
    ActiveSheet.Shapes.Item(1).Width = .Range("A1:k32").Width
    ActiveSheet.Shapes.Item(1).Height = .Range("A1:k32").Height
End With
    
ChTemp.Paste
ChTemp.Export Filename:=FName, FilterName:="png"

Application.DisplayAlerts = False
ShTemp.Delete
Application.DisplayAlerts = True

ThisWorkbook.Windows(1).DisplayGridlines = True

Application.ScreenUpdating = True

Set ShTemp = Nothing
Set ChTemp = Nothing
Set PicTemp = Nothing

End Sub

In Excel it looks like this:


After saving it looks like this:



The lines are exactly on the edges of the image, not the chart created. If I stop the macro right before

ChTemp.Export Filename:=FName, FilterName:="png"

and make ctrl+C (chart is selected at that point), ctrl+V to Paint or Word, I get no gray border.

Any help would be greatly appreciated.

 

[Jon Peltier]

Maybe try this before the export (though the border isn't apparent in your first screen shot):

ChTemp.ChartArea.Format.Line.Visible = msoFalse

That would be easy, but maybe too easy to help.

Also, I get the idea that your map is one or more shapes floating above the range A1:K32. Try copying the group of shapes, to make sure there's no stray cell border being copied.

 

[Taisho]

The easy solution didn't work, copying group of shapes also failed, leaving the same effect. The essential part of the code to do it was:

i = 1
With ThisWorkbook.Sheets("map")
    For Each shp In .Shapes
        If shp.Name <> "CommandButton1" And shp.Name <> "CommandButton2" Then
            ReDim Preserve Arr(1 To i)
            Arr(i) = shp.Name
            i = i + 1
        End If
    Next shp
    Set sr = .Shapes.Range(Arr)
    .Activate
    sr.Select
    Selection.Group.Select
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Selection.Ungroup
    ShTemp.Activate
    ActiveSheet.Shapes.Item(1).Line.Visible = msoFalse 
    ActiveSheet.Shapes.Item(1).Width = .Range("a1:k33").Width
    ActiveSheet.Shapes.Item(1).Height = .Range("a1:k33").Height
End With

ThisWorkbook.Windows(1).DisplayGridlines = False
ChTemp.Paste
ChTemp.Export Filename:=FName, FilterName:="png"

I changed range to "a1:k33" because part of 33th row was used by an image but it did nothing. The fun part was when I replaced .Range("a1:k33").Width with some random 1000 and height also with 1000. Left and right borders disappeared, bottom was barely visible and top thinner than before. Now after copying the png image to Word, only top line is barely visible on 100% zoom, bottom line starts to show around 200% what is satisfying for me as an effect but understandably not as future solution as for example 500 value as a parameter fails because of clearly visible lines.

 

[Taisho]

Now when I try to reproduce it, .Range("a1:k33").Width and .Height works as good as assigning the 1000 value, with top and bottom almost invisible, so i'm gonna use it for better scaling and display of objects. Strange. Anyway looks like your solution with grouping shapes got me to what I needed. Thanks.

 

[rd88817]

Now when I try to reproduce it, .Range("a1:k33").Width and .Height works as good as assigning the 1000 value, with top and bottom almost invisible, so i'm gonna use it for better scaling and display of objects. Strange. Anyway looks like your solution with grouping shapes got me to what I needed. Thanks.

this worked for me:

x.Chart.ChartArea.Border.LineStyle = 0

 

[Taisho]

this worked for me:

x.Chart.ChartArea.Border.LineStyle = 0

Unfortunately it didn't resolve problem for me. I have rewritten whole macro a couple of months ago, it got better. One map is completely without borders, but the second one (generated in the same way) looks like this, with whole border on the bottom:

https://postimg.org/image/hr6kibepx/

It must be kept in mind, that the border is related to the picture, not embedded Word tables. The improvement I received is due to modification of picture's crop settings, but I couldn't make it ideal.

 

[Jon Peltier]

Instead of copying the range under the shapes and pasting into the chart, why not copy the shapes themselves and paste them instead? In fact, why not draw them directly in the chart? Whenever you start chaining too many actions together, especially dealing with pictures and bitmaps and resolutions and all of that, you'll get artifacts like this.