宏 Excel：将圆圈插入单元格的特定范围

Question

我有一个直径和中心固定的圆。我现在需要做的是将圆圈插入给定范围。例如，给定 11 个列框和 10 个行框要插入到 Excel 单元格中。输入给定范围后，圆将在选定范围内，其中心固定，但框的高度和宽度会有不同的测量值。我的问题是如何将圆插入具有不同高度和宽度的单元格的任何给定范围（如 11 x 10 或 9 x 12）？

我的代码：

Sub DrawCircleWithCenter()
Dim cellwidth As Single
Dim cellheight As Single
Dim ws As Worksheet
Dim rng As Range
Dim Shp2 As Shape


CellLeft = Selection.Left
CellTop = Selection.Top

ActiveSheet.Shapes.AddShape(msoShapeOval, CellLeft, CellTop, 565 / 2, 565 / 2).Select
Selection.ShapeRange.Fill.Visible = msoFalse
With Selection.ShapeRange.Line
    .Visible = msoTrue
    .ForeColor.RGB = RGB(0, 0, 0)
    .Transparency = 0
End With

i = 182
Set Shp2 = ActiveSheet.Shapes.AddShape(i, CellLeft, CellTop, 20, 20)
Shp2.ShapeStyle = msoShapeStylePreset1
Set rng = ActiveWindow.VisibleRange

Selection.Left = rng.Width / 2 - Selection.Width / 2
Selection.Top = rng.Height / 2 - Selection.Height / 2
Shp2.Left = rng.Width / 2 - Shp2.Width / 2
Shp2.Top = rng.Height / 2 - Shp2.Height / 2


End Sub

Answer 1

如果我对您的理解正确，这可能就是您所追求的：

Sub DrawCircleWithCenter(rng As Range)
  Dim Shp1 As Shape, Shp2 As Shape

  Set Shp1 = ActiveSheet.Shapes.AddShape(msoShapeOval, rng.Left, rng.Top, rng.Width, rng.Height)
  Shp1.Fill.Visible = msoFalse
  With Shp1.Line
    .Visible = msoTrue
    .ForeColor.RGB = RGB(0, 0, 0)
    .Transparency = 0
  End With

  Set Shp2 = ActiveSheet.Shapes.AddShape(182, rng.Left, rng.Top, 20, 20)
  Shp2.ShapeStyle = msoShapeStylePreset1

  Shp1.Left = rng.Left
  Shp1.Top = rng.Top
  Shp2.Left = rng.Left + rng.Width / 2 - Shp2.Width / 2
  Shp2.Top = rng.Top + rng.Height / 2 - Shp2.Height / 2
End Sub

Sub Test()
  Dim rng As Range
  Set rng = Selection
  DrawCircleWithCenter rng
End Sub

您可以修改 Test 子例程以提供您所追求的范围。在上述情况下，我使用用户在当前工作表中突出显示的选择来绘制居中的十字和椭圆。如果你选择一个正方形区域，椭圆会变成一个圆形，如果你选择一个矩形区域，它会被压扁成一个椭圆。如果您在所选范围内有不同的单元格宽度和高度，它也可以工作。