有些Excel用户喜欢在工作表中绘制形状,以实现其目的。例如,如下图1所示,绘制一个矩形方框来强调这些单元格中的数据。
图1
我们可以使用下面的代码来完成图1中矩形的自动绘制:
Sub AddRedBox()
Dim shpBox As Shape
'以所选单元格为基准绘制红色矩形
On Error GoTo errH
Set shpBox = ActiveSheet.Shapes.AddShape( _
Type:=msoShapeRectangle, _
Left:=Selection.Left, _
Top:=Selection.Top, _
Width:=Selection.Width, _
Height:=Selection.Height)
On Error GoTo 0
'格式化形状
shpBox.Fill.Visible = msoFalse
shpBox.Line.Visible = msoTrue
shpBox.Line.ForeColor.RGB = RGB(255, 0, 0)
shpBox.Line.Weight = 2.5
Exit Sub
errH:
MsgBox "请先选择单元格区域."
End Sub
选择单元格或者单元格区域,运行AddRedBox过程,即可以在其周边添加一个红色矩形框。
如果你想移除工作表中添加的所有红色矩形框,可以使用下面的代码:
Sub RemoveAllShapes()
Dim shp As Shape
'遍历当前工作表中的所有形状
'如果不是图表/批注则删除
For Each shp In ActiveSheet.Shapes
If shp.Type <> msoChart And _
shp.Type <> msoComment Then
shp.Delete
End If
Next shp
End Sub
RemoveAllShapes过程将删除当前工作表中的所有形状。
然而,在有些情形下,工作表中可能存在除红色矩形框之外的其他形状,而我们并不想删除这些形状。实现这种情形的一个技巧是,在添加这些形状时重命名并在其名字后添加指定的字符作为标记。
例如,在添加红色矩形框时,在其名字后面添加指定的标记字符(本例中为“_MyRed”),以便以后操作时识别:
Sub AddRedBoxWithTag()
Dim shpBox As Shape
On Error GoTo errH
Set shpBox = ActiveSheet.Shapes.AddShape( _
Type:=msoShapeRectangle, _
Left:=Selection.Left, _
Top:=Selection.Top, _
Width:=Selection.Width, _
Height:=Selection.Height)
On Error GoTo 0
'重命名该形状
shpBox.Name = shpBox.Name &"_MyRed"
'格式化形状
shpBox.Fill.Visible = msoFalse
shpBox.Line.Visible = msoTrue
shpBox.Line.ForeColor.RGB = RGB(255, 0, 0)
shpBox.Line.Weight = 2.5
Exit Sub
errH:
MsgBox "请先选择单元格区域!"
End Sub
这样,就可以很方便地使用VBA代码找到所有的红色矩形框并进行相应的操作了。例如,下面的代码将当前工作表中所有的红色矩形框的颜色改为蓝色,同时将其名字进行相应的修改:
Sub ChangeRedBoxToBlueBox()
Dim shp As Shape
Dim strTag As String
'红色矩形框的名称标记
strTag = "_MyRed"
'遍历当前工作表中所有形状
For Each shp In ActiveSheet.Shapes
'检查形状名字后面指定的名称标记
If Right(shp.Name, Len(strTag)) =strTag Then
'修改颜色为蓝色
shp.Line.ForeColor.RGB = RGB(0, 0,255)
'修改形状的名称标记
shp.Name = WorksheetFunction.Substitute(shp.Name,strTag, "_MyBlue")
End If
Next shp
End Sub
对于上文图1中的示例,先运行AddRedBoxWithTag过程在所选单元格区域中添加红色矩形框,再运行ChangeRedBoxToBlueBox过程对当前工作表中所有红色矩形框进行修改,如下图2所示。