ExcelVBAでセルの座標を取得して同じ位置に図形を配置する、ということを行っているのですが、追加した図形の位置がセルからずれてしまいます。
少なくとも365以前にはこんなことはなかったはずなのですが、修正する方法はあるでしょうか。
状態(表示倍率は100%)
コード
Sub cell2box()
Dim ii As Integer, jj As Integer
For ii = 1 To 35 Step 5
For jj = 1 To 35 Step 5
Dim targetRange As Range
With ActiveSheet
Set targetRange = .Range(.Cells(ii, jj), .Cells(ii, jj))
End With
'セルの座標を取得する
Dim dLft_r As Double: dLft_r = targetRange.Left
Dim dTop_r As Double: dTop_r = targetRange.Top
Dim dWid_r As Double: dWid_r = targetRange.Width
Dim dHig_r As Double: dHig_r = targetRange.Height
'セルの座標に図形を追加する
Dim shpBox As Shape
Set shpBox = ActiveSheet.Shapes.AddShape(msoShapeRectangle, dLft_r, dTop_r, dWid_r, dHig_r)
'セルと図形の座標をセルに入れる
If ii = jj Then
targetRange.Offset(0, 0).Value = ""
targetRange.Offset(1, 0).Value = "Left"
targetRange.Offset(2, 0).Value = "Top"
targetRange.Offset(3, 0).Value = "Width"
targetRange.Offset(4, 0).Value = "Heigh"
targetRange.Offset(0, 1).Value = "Cell"
targetRange.Offset(1, 1).Value = dLft_r
targetRange.Offset(2, 1).Value = dTop_r
targetRange.Offset(3, 1).Value = dWid_r
targetRange.Offset(4, 1).Value = dHig_r
targetRange.Offset(0, 2).Value = "Shape"
targetRange.Offset(1, 2).Value = shpBox.Left
targetRange.Offset(2, 2).Value = shpBox.Top
targetRange.Offset(3, 2).Value = shpBox.Width
targetRange.Offset(4, 2).Value = shpBox.Height
End If
Next jj
Next ii
End Sub
環境
<Excel>
Microsoft® Excel® for Microsoft 365 MSO (バージョン 2603 ビルド 16.0.19822.20086) 64 ビット
<Windows>
エディション Windows 11 Pro
バージョン 25H2
OS ビルド 26200.8117
<モデレーター注>
この質問スレッドは、スパムフィルターの誤判定により削除されていましたがスレッドを復元させて頂きました。