Question

所以我制作了一个宏来复制和粘贴（折线图）从一张纸到另一张作为PNG文件。但是当我运行代码时，图形不会出现。请指教

变量＆＃34; p＆＃34;只是一个计数器，用于在循环后刷新数据时粘贴其他图形。

Worksheets("Data").Activate
    ActiveSheet.ChartObjects("Graph1").Activate
    ActiveChart.ChartArea.Copy

    Sheets("List").Select
    Range("A" & p).Select

   ActiveSheet.PasteSpecial Format:="Picture (PNG)", Link:=False, _
        DisplayAsIcon:=False
p=p+46

我试过这个但它仍然无法正常工作

 Worksheets("Data").Activate
    ActiveSheet.ChartObjects("Graph1").Activate
    ActiveChart.ChartArea.CopyPicture Format:=xlPicture

    Sheets("List").Select
    Range("A" & p).Select

   ActiveSheet.PasteSpecial

p = p + 46

@Nanashi刚尝试了这个并且不幸的是它没有工作

 Worksheets("Data").Activate
        Dim WS As Worksheet: Set WS = ActiveSheet
    Dim Cht As Chart
    Set Cht = WS.ChartObjects("StockGraph").Chart
    Cht.ChartArea.Copy



    Sheets("List").Select
    Range("A" & p).Select

 WS.Pictures.Paste

以下是所要求的代码:(感谢您的帮助！）

Sub Execute()
Dim mark As String

Worksheets("Tab").Activate
Range("I3").Select
lr = Selection.End(xlDown).row

pst = 5
pstc = 12
pstg = 6
oro = 1
opo = 3
l = 25
m = 32
n = 39
o = 5
p = 11
pstc = 21

For s = 5 To lr

On Error Resume Next

Worksheets("Tab").Activate

mark= Cells(s, 9)
Cells(6, 2) = mark

Application.Calculation = xlCalculationAutomatic

Call Macro2
Call Macro1

Application.Calculation = xlCalculationAutomatic

'==================================================================='

Range("I1:L5").Copy
Worksheets("List").Activate
Range("H" & o).PasteSpecial xlPasteValues

'''graph'''''''''
        Worksheets("Data").Activate
    ActiveSheet.ChartObjects("Graph1").Activate
    ActiveChart.ChartArea.Copy

    Sheets("List").Select
    Range("A" & p).Select

   ActiveSheet.PasteSpecial Format:="Picture (PNG)", Link:=False, _
        DisplayAsIcon:=False

p = p + 46

    Worksheets("Data").Activate
    ActiveSheet.ChartObjects("Graph1").Delete

Answer 1

使用Worksheet属性/方法.Pictures.Paste。请参阅下面的代码。

Sub Test()

    Dim WS As Worksheet: Set WS = ActiveSheet
    Dim Cht As Chart
    Set Cht = WS.ChartObjects("Chart 1").Chart
    Cht.ChartArea.Copy
    WS.Range("R1").Select
    WS.Pictures.Paste

End Sub

这会将Chart 1粘贴到R1单元格作为图片。

如果有帮助，请告诉我们。

Answer 2

这就是复制图表并粘贴图片所需的全部内容：

Sub CopyPasteChartPicture()
  ActiveChart.CopyPicture xlScreen, xlPicture
  ActiveSheet.Range("E5").Select ' or wherever...
  ActiveSheet.Paste
End Sub

VBA图表不会粘贴为PNG

2 个答案: