使用 VBA 从 Excel 复制单元格以用作图像

Question

I'm using the following code in Excel-VBA to copy an area of cells and paste it as a an image which is saved, and then displayed on a user form. It 'works' but the problem I'm having is that the object being created is not sized right. It causes my image to looks squished and distorted. How can I modify this so that my image pastes into the object without any resizing problem? I've found a lot of answers of how to do the initial part of saving the image but nothing about how to modify the size of the chart or object that I'm pasting into.

Dim k As Integer
Dim intCount As Integer
Dim objPic As Shape
Dim objChart As Chart
'copy the range as an image
Call Sheet3.Range(Cells(49, 13), Cells(51 + t - 1, 14)).CopyPicture(xlScreen, xlPicture)
''the minus 1 here means we are not seeing total cost on our item list right now.

'remove all previous shapes in sheet2
intCount = Sheet2.Shapes.Count
For k = 1 To intCount
Sheet2.Shapes.Item(1).Delete
Next k
'create an empty chart in sheet2
Sheet2.Shapes.AddChart
'activate sheet2
Sheet2.Activate
'select the shape in sheet2
Sheet2.Shapes.Item(1).Select
Set objChart = ActiveChart
'paste the range into the chart
objChart.Paste
'save the chart as a JPEG
objChart.Export ("C:\StuffBusinessTempExample.Jpg")


'Sets image to be the quote
Image1.Picture = LoadPicture("C:/StuffBusinessTempExample.jpg")

Answer 1

Something like this:

Sub tester()
    ExportRange Selection, "C:\_Stuff\Temp\Example3.Jpg"
    ExportRange ActiveSheet.Range("A2:F11"), "C:\_Stuff\Temp\Example4.Jpg"
End Sub


Sub ExportRange(rng As Range, fPath As String)

    rng.CopyPicture xlScreen, xlPicture
    With ActiveSheet.Shapes.AddChart
        'remove any data from the chart
        Do While .Chart.SeriesCollection.Count > 0
            .Chart.SeriesCollection(1).Delete
        Loop
        'resize to match the range
        .Height = rng.Height
        .Width = rng.Width
        .Chart.Paste
        .Chart.Export fPath
        .Delete
    End With

End Sub

Answer 2

You don't need to save your range as a picture, you can paste it directly from clipboard onto a workseet:

Call Range(Cells(49, 13), Cells(51 + t - 1, 14)).Copy
''the minus 1 here means we are not seeing total cost on our item list right now.

'' Do all your other stuff here

ActiveSheet.Pictures.Paste.Select