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

时间:2017-03-20 01:56:54

标签: excel vba excel-vba

我有一个固定直径和中心的圆圈。我现在需要做的是将圆圈插入给定范围。例如,在excel单元格中插入11个列和10个行的行。进入给定范围后,圆圈将在所选范围内,其固定中心,但框的高度和宽度将有不同的测量值。我的问题是如何将圆插入任何给定范围(如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

1 个答案:

答案 0 :(得分: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

您可以修改“测试”子程序以提供您之后的范围。在上面的例子中,我使用用户在当前工作表中突出显示的选项来绘制在其中心的十字和椭圆。如果选择正方形区域,则椭圆形变为圆形,具有矩形区域,它将被压扁为椭圆形。如果您在所选范围内具有不同的单元格宽度和高度,它也会起作用。