Const 高率 As Double = 0.6
Const 幅率 As Double = 0.9
Sub Test01() ' セル決め打ち
Dim rng As Range
Dim ary: ary = Array(\u0026quot;A1\u0026quot;, \u0026quot;C1\u0026quot;, \u0026quot;D1\u0026quot;, \u0026quot;D5\u0026quot;)
For Each a In ary
Set rng = Range(CStr(a)).MergeArea
Call SetShape(rng)
Next
End Sub
Sub Test02() ' 選択範囲処理
Dim c As Range, addr As String, i As Long
Dim rng As Range: Set rng = Selection
Dim res As Collection: Set res = New Collection
For Each c In rng.Cells
addr = c.MergeArea.Cells(1, 1).Address
On Error Resume Next
res.Add addr, addr
On Error GoTo 0
Next
For i = 1 To res.Count
Call SetShape(Range(res(i)).MergeArea)
Next
End Sub
Sub SetShape(rng As Range)
Dim shp As Shape, sp As Integer
sp = 9 - 2 * (rng.Cells(1, 1).Value Mod 2) ' 7:△ / 9:〇
Set shp = ActiveSheet.Shapes.AddShape(sp, _
rng.Left + rng.Width * (1 - 幅率) / 2, _
rng.Top + rng.Height * (1 - 高率) / 2, _
rng.Width * 幅率, rng.Height * 高率)
' 塗りつぶしなし、枠線のみ
With shp
.Fill.Visible = msoFalse
.Line.ForeColor.RGB = RGB(0, 0, 0)
.Line.Weight = 0.5
End With
End Sub
