0

好的，我查看了许多不同的论坛，试图找出为什么我的代码无法在 screenupdating 设置为 false 的情况下工作。我试图使用图表叠加将范围导出为 jpg 图像，那里没有什么复杂的。但是，当我关闭屏幕更新时，它只会以正确的尺寸和正确的名称导出一个空白图像（全白），但没有图像，为什么屏幕更新与复制到剪贴板的内容有任何关系，感谢您提前提供的帮助。

尝试＃1（不起作用）：

Private Sub CreateList()

On Error Resume Next
Range("Title") = "Priority List Last Updated: " & Now()
Dim rgExp As Range: Set rgExp = ThisWorkbook.Worksheets("Sheet2").Range("A1:K10")
rgExp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

With ActiveSheet.ChartObjects.Add(Left:=rgExp.Left, Top:=rgExp.Top, _
    Width:=rgExp.Width, Height:=rgExp.Height)
    .Name = "Chart1"
    .Activate
End With

ActiveChart.Paste
ActiveSheet.ChartObjects("Chart1").Chart.Export ThisWorkbook.Path & "\Priority Top 16.jpg"
ActiveSheet.ChartObjects("Chart1").Delete

End Sub

尝试#2（不起作用）：

Private Sub CreateList()

On Error Resume Next
Range("Title") = "Priority List Last Updated: " & Now()
Dim rgExp As Range: Set rgExp = Range("A1:K10")
rgExp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

With ActiveSheet
    .ChartObjects.Add(Left:=rgExp.Left, Top:=rgExp.Top, _
    Width:=rgExp.Width, Height:=rgExp.Height)
    .Name = "Chart1"
    .Activate
    With ActiveChart
        .Paste
        .Export ThisWorkbook.Path & "\Priority Top 16.jpg"
        .Delete
    End With
End With

End Sub

尝试#3（使用 screenupdating = True）：

Private Sub CreateList()

Application.ScreenUpdating = True

On Error Resume Next
Range("Title") = "Priority List Last Updated: " & Now()
Dim rgExp As Range: Set rgExp = ThisWorkbook.Worksheets("Sheet2").Range("A1:K10")
rgExp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

With ActiveSheet.ChartObjects.Add(Left:=rgExp.Left, Top:=rgExp.Top, _
    Width:=rgExp.Width, Height:=rgExp.Height)
    .Name = "Chart1"
    .Activate
End With

ActiveChart.Paste
ActiveSheet.ChartObjects("Chart1").Chart.Export ThisWorkbook.Path & "\Priority Top 16.jpg"
ActiveSheet.ChartObjects("Chart1").Delete
Application.ScreenUpdating = False

End Sub
4

1 回答 1

1

This worked fine for me:

Private Sub CreateList()

Dim sht As Worksheet
Dim rgExp As Range

    Application.ScreenUpdating = False

    Set sht = Sheet1

    Set rgExp = sht.Range("A1:K10")
    rgExp.CopyPicture Appearance:=xlScreen, Format:=xlPicture


    With sht.ChartObjects.Add(Left:=10, Top:=10, _
                        Width:=rgExp.Width, Height:=rgExp.Height)
        With .Chart
            .Paste
            .Export ThisWorkbook.Path & "\Priority Top 16.jpg"
        End With
        .Delete

    End With

End Sub
于 2013-05-07T23:53:37.393 回答