Exporting Cell Range As PNG - Getting A White Border To The Bottom & Right - Why?

[TkdKidSnake]

Hi all,

I am exporting a range of cells as a PNG however, when I look at the result I am getting a white border at the bottom and to the right (there isn't any white there) - Any ideas why and how to resolve this as it would save me having to manually edit each time.

The code I have is:

Sub Xport01Mon()
'
Sheets("Mon").Select
ActiveSheet.Unprotect

Dim ws As Worksheet
Dim table As Range
Dim pic As Picture
Dim cht As ChartObject
Dim myPath As String
Dim myPic As String
Dim myWidth As Long
Dim myHeight As Long

Set ws = ThisWorkbook.Sheets("Mon")
Set table = ws.Range("B5:X548")

myPath = "C:\Users\stevseat\Documents\001 - TST Schedule\"
myPic = Range("C1").Value

table.CopyPicture xlScreen, xlPicture
myWidth = table.Width
myHeight = table.Height

Set cht = ws.ChartObjects.Add(Left:=0, Top:=0, _
    Width:=myWidth, Height:=myHeight)
    
cht.Activate

With cht.Chart
    .Paste
    .Export Filename:=myPath & myPic, Filtername:="png"
End With

cht.Delete

ActiveSheet.Protect

End Sub

This is what I am seeing as the output:

Any help you can provide would be greatly appreciated.

Thanks in advance

 

[TkdKidSnake]

Try xlContinuous instead.

Hi, thank you for your help.

Unfortunately this didn't make a difference:

changing from:

cht.Border.LineStyle = xlLineStyleNone

changing to:

cht.Border.LineStyle = xlContinuous

 

[TkdKidSnake]

If you want to try by installing IrfanView, it is a very good program and it is free, with all the required plugins.

This is for two computers as you see.
Normally one does not need the Select Case part.

Sub With_IrfanView()
Dim myPic As Object
Dim cv As String, savePath As String
Set myPic = ActiveSheet.Range("A1:H1")    '<---- Change as required
Select Case Environ("computername")
Case "DESKTOP"
cv = "C:\Program Files\IrfanView\i_view64.exe"
Case "LAPTOP"
cv = "C:\Program Files (x86)\IrfanView\i_view32.exe"
End Select
savePath = "C:\WhatEver Folder\WhatEver Picture Save Name.jpg"    '<---- Change as required
myPic.Copy
Shell cv & " ""/clippaste /convert=" & savePath & """", vbNormalFocus
End Sub

Thanks for this I will have to try on another computer/laptop as I can only install from the Microsoft Store on this Laptop.

 

[TkdKidSnake]

Try xlContinuous instead.

The below between the dashed lines seems to have solved my issue - its the chart area that's creating what looks like a border.

Set cht = ws.ChartObjects.Add(Left:=0, Top:=0, _
    Width:=myWidth, Height:=myHeight)
'---------------------------------------------------
cht.ShapeRange.Fill.Visible = False
cht.ShapeRange.Line.Visible = False
'---------------------------------------------------

 

[TkdKidSnake]

Thanks for this I will have to try on another computer/laptop as I can only install from the Microsoft Store on this Laptop.

The below between the dashed lines seems to have solved my issue - its the chart area that's creating what looks like a border.

Set cht = ws.ChartObjects.Add(Left:=0, Top:=0, _
    Width:=myWidth, Height:=myHeight)
'---------------------------------------------------
cht.ShapeRange.Fill.Visible = False
cht.ShapeRange.Line.Visible = False
'---------------------------------------------------

 

[TkdKidSnake]

If you want to try by installing IrfanView, it is a very good program and it is free, with all the required plugins.

This is for two computers as you see.
Normally one does not need the Select Case part.

Sub With_IrfanView()
Dim myPic As Object
Dim cv As String, savePath As String
Set myPic = ActiveSheet.Range("A1:H1")    '<---- Change as required
Select Case Environ("computername")
Case "DESKTOP"
cv = "C:\Program Files\IrfanView\i_view64.exe"
Case "LAPTOP"
cv = "C:\Program Files (x86)\IrfanView\i_view32.exe"
End Select
savePath = "C:\WhatEver Folder\WhatEver Picture Save Name.jpg"    '<---- Change as required
myPic.Copy
Shell cv & " ""/clippaste /convert=" & savePath & """", vbNormalFocus
End Sub

Hi,

I've managed to solve this, it would appear its the chart background that was causing the border issue - see the below between the dashes as this has now removed the border.

Set cht = ws.ChartObjects.Add(Left:=0, Top:=0, _
    Width:=myWidth, Height:=myHeight)
'---------------------------------------------------
cht.ShapeRange.Fill.Visible = False
cht.ShapeRange.Line.Visible = False
'---------------------------------------------------
cht.Activate

 

[TkdKidSnake]

MY full code now looks like this is anyone is interested or has the same issue.

Sub Xport01Mon()
'
Sheets("Mon").Select
ActiveSheet.Unprotect

Dim ws As Worksheet
Dim table As Range
Dim pic As Picture
Dim cht As ChartObject
Dim myPath As String
Dim myPic As String
Dim myWidth As Long
Dim myHeight As Long

Set ws = ThisWorkbook.Sheets("Mon")
Set table = ws.Range("B5:X548")

myPath = "C:\Users\stevseat\Documents\001 - TST Schedule\"
myPic = Range("C1").Value

table.CopyPicture xlScreen, xlPicture
myWidth = table.Width
myHeight = table.Height

Set cht = ws.ChartObjects.Add(Left:=0, Top:=0, _
    Width:=myWidth, Height:=myHeight)
'---------------------------------------------------
cht.ShapeRange.Fill.Visible = False
cht.ShapeRange.Line.Visible = False
'---------------------------------------------------
cht.Activate
cht.Border.LineStyle = 0

With cht.Chart
    .Paste
    .Export Filename:=myPath & myPic, Filtername:="png"
End With

cht.Delete

ActiveSheet.Protect

End Sub

 

[jolivanes]

Like John_w, thumbs up and thanks for letting us know.