时间戳

首页 > 解决方案 > 使用 For 循环从其他工作表返回命名图表

excel - 使用 For 循环从其他工作表返回命名图表

问题描述

我正在尝试使用 For 循环复制/粘贴与参考单元格同名的命名图表，下面的函数返回正确的图表，但只是复制/粘贴有问题的图表 36 次（我的工作表数文档）。我一开始就使用了错误的功能吗？

Dim aChar As ChartObject 'these lines define the name of the chart
Dim aFlag As Boolean
Dim aCharName As String
On Error Resume Next
Application.ScreenUpdating = False
aCharName = (Sheets("Sheet1").Range("A1"))
aFlag = False
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets 'The For Loop: I think this is where the problem is

If aChar.Name = aCharName Then

ws.ChartObjects(Sheets("Sheet1").Range("A1")).Activate
ActiveChart.ChartArea.Copy 'from now on the simple copy/paste 
Sheets("Sheet1").Select
Range("A2").Select
ActiveSheet.Pictures.Paste

End If

Next

非常感谢

标签： excelvbaloopsfor-loop

解决方案

以下内容如何，​​它不仅会遍历您的工作表，而且会在检查名称是否匹配之前检查并遍历每个工作表中的图表，如果匹配，则将图表粘贴到 Sheet1 的 A 列中的下一个可用行中：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim aFlag As Boolean: aFlag = False
Dim aCharName As String: aCharName = Sheets("Sheet1").Range("A1").Value
Dim i As Long
Dim ws As Worksheet
'On Error Resume Next
Application.ScreenUpdating = False
    For Each ws In ThisWorkbook.Worksheets 'The For Loop: I think this is where the problem is
        If ws.ChartObjects.Count > 0 Then 'check if there are any charts in worksheet
            For i = 1 To ws.ChartObjects.Count 'loop through charts
                If ws.ChartObjects.Name = aCharName Then
                    ws.ChartObjects(aCharName).ChartArea.Copy 'from now on the simple copy/paste
                    LastRow = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "A").End(xlUp).Row ' get the last row
                    Sheets("Sheet1").Select
                    Sheets("Sheet1").Range("A" & LastRow).Select
                    ActiveSheet.Pictures.Paste 'paste in the new last row
                    'probably best to use Offset to paste for the next iteration of the For Loop
                End If
            Next i
        End If
    Next
Application.ScreenUpdating = True
End Sub

推荐阅读