マクロExcel：セル内の特定の範囲に円を挿入するには

Question

私は固定された直径と中心を持つ円を持っています。私が今必要とするのは、指定された範囲に円を挿入することです。たとえば、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 

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 

後に。上記のケースでは、ユーザーが現在のワークシートで強調表示している選択を使用して、その内側に十字と楕円を描きます。正方形の領域を選択した場合、楕円形は円になり、長方形の領域では楕円形になります。また、選択した範囲でセル幅と高さが異なる場合にも機能します。