[VBA] export selected range as PNG with enhance resolution

smallxyz

Active Member
Joined
Jul 27, 2015
Messages
368
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!
 

Some videos you may like

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.

Rijnsent

Well-known Member
Joined
Oct 17, 2005
Messages
1,208
Office Version
365
Platform
Windows
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
 

smallxyz

Active Member
Joined
Jul 27, 2015
Messages
368
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,090,055
Messages
5,412,091
Members
403,411
Latest member
aspofford

This Week's Hot Topics

Top