excel（2010） – 循环遍历Range中的每个单元格并绘制一个椭圆

我是新来的vba，我正在试图让一个macros在一个范围内的每一个圆圈绘制一个椭圆形我已经find一个代码在一个选定的单元格中的椭圆形

Sub Add_Oval_in_ActiveCell() Worksheets("Sheet1").Activate Range("A1:A6").Select Range("A2").Activate t = ActiveCell.Top l = ActiveCell.Left h = ActiveCell.Height w = ActiveCell.Width ActiveSheet.Shapes.AddShape(msoShapeOval, l, t, w, h).Select Selection.ShapeRange.Fill.Visible = msoFalse With Selection.ShapeRange.Line .Visible = msoTrue .ForeColor.RGB = RGB(255, 0, 0) .Transparency = 0 End With With Selection.ShapeRange.Line .Visible = msoTrue .Weight = 2.25 End With End Sub 

这可以在单元格A2中绘制一个椭圆形

我怎样才能使它在一个单元格范围内循环？

先谢谢你

Answer 1

这在一个范围内的每个单元格跟踪椭圆形：

 Sub sof20302984AddOvalInActiveCell() Dim t, l, h, w Dim aCell ' 'Worksheets("Sheet1").Activate 'Range("A1:A6").Select ' For Each aCell In Range("A1:B6") aCell.Activate t = ActiveCell.Top l = ActiveCell.Left h = ActiveCell.Height w = ActiveCell.Width ActiveSheet.Shapes.AddShape(msoShapeOval, l, t, w, h).Select Selection.ShapeRange.Fill.Visible = msoFalse With Selection.ShapeRange.Line .Visible = msoTrue .ForeColor.RGB = RGB(255, 0, 0) .Transparency = 0 End With With Selection.ShapeRange.Line .Visible = msoTrue .Weight = 2.25 End With Next Set aCell = Nothing End Sub 

Answer 2

 'try this one Set myDocument = Worksheets(1) With myDocument.Shapes For Z = .Count To 1 Step -1 With .Item(Z) If .Name = "oval" Then .Delete End With Next End With Dim t, l, h, w Dim aCell ' For Each aCell In Range("A1:B6") aCell.Activate t = ActiveCell.Top l = ActiveCell.Left h = ActiveCell.Height w = ActiveCell.Width ActiveSheet.Shapes.AddShape(msoShapeOval, l, t, w, h).Select Selection.ShapeRange.Name = "oval" Selection.ShapeRange.Fill.Visible = msoFalse With Selection.ShapeRange.Line .Visible = msoTrue .ForeColor.RGB = RGB(255, 0, 0) .Transparency = 0 End With With Selection.ShapeRange.Line .Visible = msoTrue .Weight = 2.25 End With Next Cells(1, 1).Activate Set aCell = Nothing