[VBA] export selected range as PNG with enhance resolution

smallxyz

Active Member
Joined
Jul 27, 2015
Messages
392
Office Version
  1. 2021
Platform
  1. Windows
I found the following code in exporting selected range into PNG.
It works well. However, the displayed image is a bit non-smooth, especially the font.
Is there a way to enhance the export resolution?

Thanks.


Code:
Sub CommandButton56_Click()
    Application.ScreenUpdating = False
    '---------------------
    Dim vFilePath As Variant
    Dim rSelection As Range
    Dim sDefaultName As String
    '---------------------
    If TypeName(Selection) <> "Range" Then
        MsgBox "Selection is not a range."
        Exit Sub
    Else
        Set rSelection = Selection
        vFilePath = Application.GetSaveAsFilename(InitialFileName:="Clip", FileFilter:="PNG (*.png), *.png")
        
        '--exit if cancelled by user
        If (vFilePath = False) Then
            Exit Sub
        Else
            
            '-- copy selected range as picture (not as bitmap)
            rSelection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
            
            '--Create an empty chart, slightly larger than exact size of range copied
            With ActiveSheet.ChartObjects.Add(Left:=rSelection.Left, Top:=rSelection.Top, Width:=rSelection.Width + 2, Height:=rSelection.Height + 2)
                With .Chart
                    ' clean up chart
                    .ChartArea.Format.Line.Visible = msoFalse
                    
                    ' paste and position picture
                    .Paste
                    With .Pictures(1)
                        .Left = .Left + 2
                        .Top = .Top + 2
                    End With
                    
                    ' export
                    
                    .Export CStr(vFilePath)
                End With
                ' remove no-longer-needed chart
                .Delete
            End With
        End If
    End If     
    '--------------------------
End Sub


Thanks a lot!
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Hi Smallxyz,
did you try zooming in, I guess that will help.

Code:
'Before export
ActiveWindow.Zoom = 200

'After export
ActiveWindow.Zoom = 100
Cheers,
Koen
 
Upvote 0
Hi Koen,
It did enlarge the exported image.
However, the font still remains not so smooth enough.
There is still a difference between what user can see in front of the screen and the exported view of image.
 
Upvote 0

Forum statistics

Threads
1,214,613
Messages
6,120,515
Members
448,968
Latest member
Ajax40

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top