选择多个Excel图表



我正在寻找一种使用VBA在Excel中选择多个图表的方法。

这可以通过在ChatObject上使用.Select来完成,但我不能像那样选择多个图表。如果每次使用CCD_ 4时在CCD_;最后一个";图表并取消选择上一个图表。

如何选择满足条件的多个图表(无论是什么(?或者,如何将新的选择添加到以前选择的项目中?

Sub select_charts()
Dim chtObjs As ChartObjects
Set chtObjs = ActiveSheet.ChartObjects
Dim chtObj As ChartObject
For Each chtObj In chtObjs
If chtObj.Height > 100 Then
chtObj.Select
End If
Next
End Sub

VBA能够使用包含对象名称或其索引的数组来选择更多对象。

  1. 回答您的问题最简单的方法是:
ActiveSheet.Shapes.Range(Array("Chart 1", "Chart 2")).Select
  1. 您可以构建这样一个数组(使用某些条件(,并最终使用它进行选择:
Sub testSelectCharts()
Dim sh As Worksheet, s As Shape, arrChObj(), arrChIndex(), i As Long, k As Long

Set sh = ActiveSheet
ReDim arrChObj(sh.Shapes.count - 1)    'ReDim the array to be sure that it has enough elements
ReDim arrChIndex(sh.Shapes.count - 1)  'ReDim the array to be sure that it has enough elements
For Each s In sh.Shapes                'iterate between all shapes
i = i + 1                            'the shape index
If TypeOf s.OLEFormat.Object Is ChartObject Then 'act only for chart objects:
arrChIndex(k) = i               'loading an array of shapes index
arrChObj(k) = s.Name: k = k + 1 'loading an array of shapes name
End If
Next
ReDim Preserve arrChObj(k - 1)        'preserving only the array elements containing values
ReDim Preserve arrChIndex(k - 1)      'preserving only the array elements containing values
sh.Shapes.Range(arrChObj).Select      'selecting using array object names  
'sh.Shapes.Range(arrChIndex).Select   'it works using sheet indexes, too (just uncomment and comment the above code line)
End Sub
  1. 您可以通过以下方式选择/激活工作表:
Sub testSheetsSelect()
Worksheets(Array(Sheets(1).Name, Sheets(3).Name)).Select
'Worksheets(Array(1, 3)).Select     'using an array of sheets indexes
End Sub
  1. 下一个测试子选择类型为";CommandButton";。当然,活动工作表应该至少有一个这样的控件和其他一些不同类型的控件(组合框、列表框等(:
Sub testObjectsNameArray()
Dim sh As Worksheet, objOLE As OLEObject, arrOLE(), k As Long
Set sh = ActiveSheet
ReDim arrOLE(sh.OLEObjects.count - 1)
For Each objOLE In sh.OLEObjects
If TypeOf objOLE.Object Is MSForms.CommandButton Then
arrOLE(k) = objOLE.Name: k = k + 1
End If
Next
ReDim Preserve arrOLE(k - 1)
sh.OLEObjects(arrOLE).Select
End Sub

索引数组也应该工作。。。

最新更新