11

特定のセル位置に形状を追加しようとしていますが、何らかの理由で目的の位置に形状を追加できません。以下は、形状を追加するために使用しているコードです。

Cells(milestonerow, enddatecellmatch.Column).Activate

Dim cellleft As Single
Dim celltop As Single
Dim cellwidth As Single
Dim cellheight As Single

cellleft = Selection.Left
celltop = Selection.Top

ActiveSheet.Shapes.AddShape(msoShapeOval, cellleft, celltop, 4, 10).Select

変数を使用して左と上の位置をキャプチャし、コードに設定されている値と、マクロの記録中にアクティブな場所に手動で形状を追加したときに表示された値を確認しました。コードを実行すると cellleft = 414.75 および celltop = 51 になりますが、マクロの記録中にアクティブなセルの位置に手動で形状を追加すると、cellleft = 318.75 および celltop = 38.25 になります。私はしばらくこれをトラブルシューティングしており、図形の追加に関する多くの既存の質問をオンラインで調べましたが、これを理解できません. どんな助けでも大歓迎です。

4

6 に答える 6

15

これは私のために働いているようです。最後にデバッグ ステートメントを追加して、形状の.Topandがセルのandの値と.Left等しいかどうかを表示しました。.Top.Left

このために、 cell を選択しましC2た。

セルの上部と左側に挿入された図形

Sub addshapetocell()

Dim clLeft As Double
Dim clTop As Double
Dim clWidth As Double
Dim clHeight As Double

Dim cl As Range
Dim shpOval As Shape

Set cl = Range(Selection.Address)  '<-- Range("C2")

clLeft = cl.Left
clTop = cl.Top
clHeight = cl.Height
clWidth = cl.Width

Set shpOval = ActiveSheet.Shapes.AddShape(msoShapeOval, clLeft, clTop, 4, 10)

Debug.Print shpOval .Left = clLeft
Debug.Print shpOval .Top = clTop

End Sub
于 2013-04-16T13:56:06.937 に答える