使用 VBA 從 Excel 復制單元格以用作圖像

Question

我在 Excel-VBA 中使用以下代碼復制單元格區域並將其粘貼為保存的圖像，然后顯示在用戶表單上。 它“有效”，但我遇到的問題是正在創建的對象大小不正確。 它使我的圖像看起來被壓扁和扭曲。 如何修改它以便我的圖像粘貼到對象中而沒有任何調整大小的問題？ 我找到了很多關於如何執行保存圖像的初始部分的答案，但沒有找到關於如何修改我粘貼到的圖表或對象的大小的答案。

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

像這樣的東西：

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

您不需要將范圍保存為圖片，您可以將其直接從剪貼板粘貼到工作表上：

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