Question

我目前想要将一堆图形/图表对象存储到VBA中的数组中，以便我可以稍后将它们全部打印出来或将它们导出为PDF。最好的方法是什么？我是否必须使用形状对象，或者我可以使用图表吗？

    Sub onButtonClick()

Dim source As Worksheet, target As Worksheet
Set source = Workbooks("End Market Monitor.xlsm").Worksheets("Aero Graphs")
Set target = Sheet1

Dim ws As Worksheet
Dim title_name As String, search As String



search = ActiveCell.Offset(0, -5).Value
ReDim chartArray(1 To source.ChartObjects.Count) As Chart
For i = 1 To source.ChartObjects.Count
    title_name = source.ChartObjects(i).Chart.ChartTitle.Text
    counter = 1
    If InStr(title_name, search) > 0 Then
        Set chartArray(counter) = source.ChartObjects(i).Chart
        counter = counter + 1
    End If

Next
Set wsTemp = Sheets.Add

    tp = 10

    With wsTemp
        For n = 1 To UBound(chartArray)
            chartArray(n).CopyPicture
            wsTemp.Range("A1").PasteSpecial
            Selection.Top = tp
            Selection.Left = 5
            tp = tp + Selection.Height + 50
        Next
    End With

    wsTemp.ExportAsFixedFormat Type:=xlTypePDF, Filename:=NewFileName, Quality:=xlQualityStandard, _
           IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub

Answer 1

你可以摆脱ActiveCell.Select。已选择活动单元格。它是多余的/不必要的。不会导致任何错误，但它不需要在那里。

此行有错误：

chartArray(i) = source.ChartObjects(i).Chart

分配给对象时需要使用Set关键字，而chartArray()是一个对象数组。

Set chartArray(i) = source.ChartObjects(i).Chart

您应该Dim自己的所有变量，或明确键入它们。这是错的：

Dim source, target As Worksheet

因为VBA不支持隐式/内联声明。你真正做的是：

Dim source as Variant, target as Worksheet

更改为：

Dim source as Worksheet, target as Worksheet

对title_name和search执行相同操作。

变量name未声明且未分配。变量i未声明。不是错误，但这是一个不好的习惯。您可以通过在每个模块的顶部使用Option Explicit来避免这种情况。您需要为name分配一些值，否则Instr测试将始终为false，并且不会为该阵列分配图表。

您的ReDim语句错误，因为您在循环中重新标注了它，并在每次迭代时有效地删除它。把这个放在for / next循环的之外。

ReDim chartArray(1 to source.ChartObjects.Count)

总而言之，您的代码应该是：

Option Explicit Sub onButtonClick() Dim source as Worksheet, target As Worksheet Set source = Workbooks("End Market Monitor.xlsm").Worksheets("Aero Graphs") Set target = Sheet1 Dim title_name As String, search As String Dim name as String name = "???" '## YOU NEED TO UPDATE THIS SOMEHOW search = Range("J3").Offset(0, -5).Value ReDim chartArray(1 To source.ChartObjects.Count) As Chart For i = 1 To source.ChartObjects.Count title_name = source.ChartObjects(i).Chart.ChartTitle.Text If InStr(title_name, name) > 0 Then Set chartArray(i) = source.ChartObjects(i).Chart End If Next End Sub

<强>更新

您可以将此程序用于多个按钮。目前，您有一个硬编码Range("J3")表示一个命令按钮的单元格位置。您可以像这样修改它，然后将相同的宏分配给所有按钮：

search = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(0, -5).Value

确保按钮的TopLeftCell位于F列或更高位置。如果这是在A，B，C，D或E列中，它将失败。

在Array中存储图表对象

1 个答案: