mat********

2022/5/25 11:28

22回答

ExcelのVBAコードについて教えてください。 マクロを実行しないで シート名が「審査」にVBAコードを設定して同じように図形を移動させる方法を教えてください。 作業ブックに

ExcelのVBAコードについて教えてください。 マクロを実行しないで シート名が「審査」にVBAコードを設定して同じように図形を移動させる方法を教えてください。 作業ブックに 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 マクロ式があります。 マクロを事項すると図形名の図形の中央が指定セルの中央に移動できるマクロです。 1. シート名が「審査」のセル値Y11が「電子申請」と表示されたタイミングで 図形「電子審査」「審査完了」「チェック完了」を上記の設定で移動 2. シート名が「審査」のセル値Y13が「Web」と表示されたタイミングで 図形「PDF」を上記の設定で移動する方法を教えてください。 コードの最初を「Private Sub Worksheet_Change(ByVal Target As Range)」 に設定すれば良いと思いますが、その先のコードがわかりません。 よろしくお願いいたします。

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

ベストアンサー

0
tak********

2022/5/25 15:41

以下のようなものでしょうか？一応、前に返答したので。 Private Sub Worksheet_Change(ByVal Target As Range) ''対象外の場合は処理しない。 If Target.CountLarge <> 1 Then Exit Sub ''対象のセルと文字であれば、図を移動する。 Dim shp As Shape Select Case True Case Not Intersect(Target, Range("Y11")) Is Nothing If Target.Value = "電子申請" Then 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 End If Case Not Intersect(Target, Range("Y13")) Is Nothing If Target.Value = "Web" Then 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 If Case Else End Select End Sub

mat********

質問者2022/5/25 16:12

回答ありがとうございました。 又、以前にも同じような質問をして、回答くださり感謝いたします。 貴者のコードで上手くいきましたが 一つ問題がありました、 実はセルY11には「=受付!D12」数式があり 同じくセルY13には「=受付!E12」があります。 受付シートでD12「電子申請」とE12「Web」がにそれぞれ表示され Y11に「電子申請」Y13に「Web」が表示されても上手く動作しませんでしたが Ｙ11とＹ13にそれぞれ直接文字を入力しましたら上手く動作してくれました。 この内容の解決方法を教えて頂けますでしょうか。 よろしくお願いいたします。

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

詳しく説明していただき、ありがとうございます。 全て解決いたしました、 感謝いたします。

お礼日時：5/26 8:31

その他の回答（1件）

0
spe********

2022/5/25 17:43

すみません、前回回答したのですが、PCにログインできずタブレットでコードを手打ちして投稿したところ、文字列の貼り付けがちゃんとできてないことに気づかずコードが不完全でエラーになってしまったようです。質問がすでに締め切られていたので、こちらの投稿をお借りしてお詫びします。 そこで、今回のご質問は別の方が回答されていますが、上に示されたコードの記述がもう少し簡単にできますので、掲載しておきます。ご参考になればと思います。配列と変数の定義の追加と、If～End If の間を変更、図形挿入のサブルーチン化の部分のみ抜粋して記述しています。 Sub メイン() Dim strAry As String Dim i As Long ReDim ary(1 To 4, 1 To 2) ary(1, 1) = "L6": ary(1, 2) = "電子審査" ary(2, 1) = "L9": ary(2, 2) = "審査完了" ary(3, 1) = "L12": ary(3, 2) = "チェック完了" ary(4, 1) = "L15": ary(4, 2) = "PDF" If Target.Value = "電子申請" Then For i = 1 To 3 Call 図形挿入(ary(i, 1), ary(i, 2)) Next i End If If Target.Value = "Web" Then Call 図形挿入(ary(4, 1), ary(4, 2)) End If ’/ 図形挿入はサブルーチン化 Sub 図形挿入(ByVal trgRng As String, ByVal trgShp As String) Dim shp As Shape With Range(trgRng) Set shp = ActiveSheet.Shapes(trgShp) shp.Top = .Top + (.Height - shp.Height) / 2 shp.Left = .Left + (.Width - shp.Width) / 2 End With End Sub

この返信は削除されました