mat********

2022/5/25 8:28

33回答

Excelマクロコードについて教えてください。 Sub 図形移動() ActiveSheet.Shapes("電子審査").Left = Range("L6").Left

Excelマクロコードについて教えてください。 Sub 図形移動() ActiveSheet.Shapes("電子審査").Left = Range("L6").Left ActiveSheet.Shapes("審査完了").Left = Range("L9").Left ActiveSheet.Shapes("チェック完了").Left = Range("L12").Left ActiveSheet.Shapes("PDF").Left = Range("L15").Left End Sub のコードがあります。このコードは該当する図形名の図形を指定したセル値に移動できるコードです。 現状のコードでは図形の左端がセルの左端に合うように移動します。 これを、図形の中心がセルの中心に合うように移動させていのですが Leftを「centre」に変更したらエラーが出てしまい、上手く実行が出来ません。 解決方法をよろしくお願いいたします。

Visual Basic | Excel・82閲覧・xmlns="http://www.w3.org/2000/svg">25

ベストアンサー

0
tak********

2022/5/25 10:13

図がセル内に収まっているのであれば、 Sub 図形移動() Dim shp As Shape With Range("L6") Set shp = ActiveSheet.Shapes("電子審査") shp.Top = .Top + (.Height - shp.Height) / 2 shp.Left = .Left + (.Width - shp.Width) / 2 End With With Range("L9") Set shp = ActiveSheet.Shapes("審査完了") shp.Top = .Top + (.Height - shp.Height) / 2 shp.Left = .Left + (.Width - shp.Width) / 2 End With With Range("L12") Set shp = ActiveSheet.Shapes("チェック完了") shp.Top = .Top + (.Height - shp.Height) / 2 shp.Left = .Left + (.Width - shp.Width) / 2 End With With Range("L15") Set shp = ActiveSheet.Shapes("PDF") shp.Top = .Top + (.Height - shp.Height) / 2 shp.Left = .Left + (.Width - shp.Width) / 2 End With End Sub でいいのでは？

ThanksImg質問者からのお礼コメント

回答ありがとうございました。 全て解決いたしました。

お礼日時：5/25 11:11

その他の回答（2件）

1
taihenda****

カテゴリマスター

2022/5/25 10:10

Topは設定不要？ 同じことを何回も書くならべつのプロシージャにしたほうがいいのかな？ Topは各セルのTopに設定しています。 Sub 図形移動() Call 位置決め("電子審査", "L6") Call 位置決め("審査完了", "L9") Call 位置決め("チェック完了", "L12") Call 位置決め("PDF", "L15") End Sub Sub 位置決め(sn As String, ad As String) Dim l As Double, t As Double l = Range(ad).Left + Range(ad).Width / 2 t = Range(ad).Top With ActiveSheet.Shapes(sn) .Left = l .Top = t End With End Sub

画像

1人がナイス！しています

0
spe********

2022/5/25 9:09

center というプロパティはないのでエラーになります。 ↓を参考にしてください。セルの左端の座標からセル幅の1/2と図形幅の1/2の差だけオフセットしてあげればよいということです。 Dim myRng As Range Dim shpOfs As Single, celOfs As Single Set myRng = Range("セル番地") celOfs = myRng.Width /2 shpOfs = ActiveSheet.Shapes("図形").Left = _ myRng.Left + celOfs - shpOfs Set myRng = Nothing

mat********

質問者2022/5/25 9:30

回答ありがとうございます。 Sub 図形移動() Dim myRng As Range Dim shpOfs As Single, celOfs As Single Set myRng = Range("L6") celOfs = myRng.Width / 2 shpOfs = ActiveSheet.Shapes("電子審査").Left = _ myRng.Left + celOfs - shpOfs Set myRng = Nothing End Sub のコードを設定し、マクロを実行しましたが、 上手く作動しませんでした（まったく図形が動かない） 申し訳ありません、解決方法をお願いいたします。