【问题标题】:Copy-Paste image to chart improperly pastes a blank image将图像复制粘贴到图表不正确地粘贴空白图像
【发布时间】:2014-10-22 16:41:52
【问题描述】:

我对此有一个切题的问题:Using VBA Code how to export excel worksheets as image in Excel 2003?

具体来说,当宏将范围的副本粘贴到图表时,图像是空白的,即使复制的范围包含 5 个图表和一些格式化的单元格。当我手动执行完全相同的步骤时,一切都按预期工作。

更奇怪的是,我已经记录了除了导出步骤之外的整个过程。当我运行录制的宏时,它可以工作。但是,当我从下面的 For Each 循环中的录制宏中复制代码并对其进行调整以指向宏正在处理的工作表(即用“t”替换“ActiveSheet”)时,宏不再起作用。

我什至在使用 For Each 移动到每张纸后调用了录制的宏,仍然粘贴了一个空白图像。

如果能提供任何帮助,我将不胜感激。

我的代码:

Sub ExportCharts()
Dim Rng As Range
Dim S As Worksheet
Dim wb As Workbook
Set wb = ThisWorkbook
Dim EName As String
Dim CO As ChartObject
Dim C As Chart
Dim temp As String

Application.ScreenUpdating = False

'Iterate through the sheets in the workbook
For Each t In wb.Worksheets
    'Capture the sheet
    Set S = t

    S.Activate
    'Set the range to be exported
    Set Rng = S.Range("A1:Z60")

    'Copy range as picture onto Clipboard
    Rng.Select
    Rng.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

    'Build the chart/file name
    EName = S.Name & " Quality Charts"

    'Create an empty chart with exact size of range to be copied
    S.Range("$AA$1:$AC$2").Select
    ActiveSheet.Shapes.AddChart.Select
    Set C = ActiveChart
    temp = Right(C.Name, Len(C.Name) - 1 - Len(S.Name))

    S.Shapes(temp).Height = Rng.Height
    S.Shapes(temp).Width = Rng.Width

    'Paste into chart area, export to file, delete chart
    'C.Activate
    With C
        .Paste
        .Export "\\COMPUTERNAME\Users\USERNAME\Desktop\My Documents\" & EName & ".jpg"
        'Note the above is an actual hard coded path in my code (yes I want it hard coded)
    End With
    C.Delete
Next

Application.ScreenUpdating = True

End Sub

【问题讨论】:

    标签: excel vba charts


    【解决方案1】:

    所以我终于弄清楚了这个问题。关闭屏幕更新的线路是问题所在。

    有人会认为这是因为我说的是屏幕上出现的复制(为什么 MS 不允许该命令使用上次屏幕更新时出现的显示,这超出了我的理解,但它并不完全像 Excel没有错误)。

    在任何情况下,注释掉该行都会产生良好的粘贴效果。

    对于那些在宏中进行更多操作并且想要/需要关闭屏幕更新以获得合理的运行速度的人的说明,在我发现问题后,我尝试在复制为图片之前重新激活屏幕更新,然后之后立即再次将其关闭,并且有效。

    【讨论】:

    • 我很有希望,但这对我不起作用
    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2020-06-11
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多