Excel VBA copy range as image with scaling

I have the following code that convert a range to image and save it to file. My problem is, I want to scale up the copied range to higher resolution/dpi to get bigger picture

Sub SaveRangeToImage(rng As Range, path As String)
    ''' Set Range you want to export to file
    Dim rgExp As Range: Set rgExp = rng
    ''' Copy range as picture onto Clipboard
    rgExp.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    ''' Create an empty chart with exact size of range copied
    With ActiveSheet.ChartObjects.Add(Left:=rgExp.Left, Top:=rgExp.Top, _
    Width:=rgExp.Width, Height:=rgExp.Height)
    .name = "img_img"
    .Activate
    End With
    ''' Paste into chart area, export to file, delete chart.
    ActiveChart.Paste
    ActiveSheet.ChartObjects("img_img").Chart.Export path
    ActiveSheet.ChartObjects("img_img").Delete
End Sub

I need to scale image up in order to get best text quality, if I resize it afterward, it gives me poor text visibility.

does anyone have an idea about this problem?

Upvotes: 0

Views: 9968

Answers (2)

SMS
SMS

Reputation: 1

Increase the zoom of the active window to increase resolution.

Add in before the export: ActiveWindow.Zoom = 300 Then after the export add: ActiveWindow.Zoom = 100

Upvotes: 0

paul bica
paul bica

Reputation: 10705

try changing the parameters:

rgExp.CopyPicture Appearance:=xlPrinter, Format:=xlBitmap
  • xlPrinter = might improve resolution for printing
  • xlBitmap = will definitely increase the resolution as a bitmap

but @Dubison's suggestion will make the main difference:

  • the chart in Excel is a "vector" image - increasing its size will not lower the resolution (bitmap images will have the same number of pixels at all sizes, vectors increase the number of pixels dynamically before being converted to a bitmap for printing)

Upvotes: 2

Related Questions