Question

好的，我看了很多不同的论坛，试图找出为什么我的代码不能使用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

Answer 1

这对我来说很好：

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

将图表对象导出为jpg将无法使用screenupdating关闭

1 个答案: