ExcelのVBAコードについて教えてください。

Question

マクロを実行しないで
シート名が「審査」に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)」
に設定すれば良いと思いますが、その先のコードがわかりません。
よろしくお願いいたします。

Qchan1962 · Accepted Answer

こんにちは
少し気になる点が・・・　＞表示されたタイミングで
これ、入力でなく（関数）式での表示ですか？
そうであれば、Worksheet_Changeではうまく行かないかな・・

入力でならWorksheet_ChangeでIntersectを使い対象セルを制御（限定）し
実行コードを実行するようにします。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("Y11")) Is Nothing Then
        If Target = "電子申請" Then
            Call shp_move(ActiveSheet.Shapes("電子申請"), Range("L6"))
            Call shp_move(ActiveSheet.Shapes("審査完了"), Range("L9"))
            Call shp_move(ActiveSheet.Shapes("チェック完了"), Range("L12"))
        End If
    End If
    If Not Intersect(Target, Range("Y13")) Is Nothing Then
        If Target = "Web" Then
            Call shp_move(ActiveSheet.Shapes("PDF"), Range("L15"))
        End If
    End If
End Sub

Sub shp_move(shp As Shape, r As Range)
    With r
        shp.Top = .Top + (.Height - shp.Height) / 2
        shp.Left = .Left + (.Width - shp.Width) / 2
    End With
End Sub

同じコードが複数回あるのでサブに出しました
ほぼ、コピペで書いたので、エラー処理、イベント抑制などは組み込んでいません

数式の場合は、もう少し情報がないと難しいかと思いますが取敢えず

Qchan1962 · Answer

こんにちは
直接（数式などでなく）値の変わるセルは？
=受付!D2　なので　受付シートD2ではないのでしょうか
受付シートD2も数式で値が入るのなら　その式を教えてください

変更になった時の為に
Worksheet_Changeのトリガーはイベントが書かれているシートです
受付シートなら、受付シート　
シート審査ならシート審査のシートモジュールに書きます

Worksheet_Changeは数式で変更表示された値（シートの計算処理）では
動きません。

なので、値が表示されるセルにどの様な数式が入っているか理解する必要があります。（Worksheet_Changeの場合、数式の参照元を実行トリガーにします）

数式のセルを選択して　リボンタグ　数式の参照元のトレースボタンを
押下して参照元をだどりましょう。（参照元が続く場合、Beepが鳴るまで複数回押します）
シートがまたがるとシートのアイコンが出ます。
もっとも、数式を見れば、どこのセルが参照元か分かると思いますが。

で、多分コードを書いたシートモジュールが違います

Range("Z12")は Range("D12")　かと　＃２に書きました

=IF(AND(Y11="電子申請",Y12="無"),"電子無","")
これ　Y12？　Y13では・・・

＞セルY11には「=受付!D12」数式があり 同じくセルY13には「=受付!E12」があります。
ならば、色々やり方はありますが、一例として

受付E12　は　"無"か"Web"で・・処理したいのだと思うので
受付E12をトリガーにして

＜受付シートモジュールに書きます＞
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wS As Worksheet
    Set wS = Worksheets("審査")
    If Not Intersect(Target, Range("E12")) Is Nothing Then　'実行セル
        If Range("D2").Text & Range("E12").Text = "電子申請無" Then
            Call shp_move(wS.Shapes("電子申請"), wS.Range("L6"))
            Call shp_move(wS.Shapes("審査完了"), wS.Range("L9"))
            Call shp_move(wS.Shapes("チェック完了"), wS.Range("L12"))
            Call shp_move(wS.Shapes("PDF"), wS.Range("L15"))
        End If
    End If
End Sub
＜審査シートのコードは消して＞
受付D2を変更した時も実行するには
If Not Intersect(Target, Range("D2,E12")) Is Nothing Then

Qchan1962 · Answer

問題はシートイベントのトリガーにあります・・いや、問題ではなく仕様なのですが・・
再計算をトリガーにする場合はPrivate Sub Worksheet_Calculate()なのですが、これにはByVal Target As Rangeが有りません。
色々やり方はあるのですが、・・・
私的には　受付シートのWorksheet_Changeイベントで対応した方が良いかも知れません。（受付シートにChangeイベントなどがすでにある場合は少し複雑になるかも知れませんが）

ちなみにこの、
受付シートでD12「電子申請」とE12「Web」がにそれぞれ表示され
はどのように表示されるのでしょう？リストボックス？数式？フォームなどからの出力？　この条件が分からないと受付シートのWorksheet_Changeイベントはやはり使いにくいかも知れませんね

受付シートのD12　E12値そのものが変わる場合、
Worksheets("審査")を付加すればOKかと思います。

受付シートモジュールに
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wS As Worksheet
    Set wS = Worksheets("審査")
    If Not Intersect(Target, Range("D12")) Is Nothing Then
        If Target = "電子申請" Then
            Call shp_move(wS.Shapes("電子申請"), wS.Range("L6"))
            Call shp_move(wS.Shapes("審査完了"), wS.Range("L9"))
            Call shp_move(wS.Shapes("チェック完了"), wS.Range("L12"))
        End If
    End If
    If Not Intersect(Target, Range("E12")) Is Nothing Then
        If Target = "Web" Then
            Call shp_move(wS.Shapes("PDF"), wS.Range("L15"))
        End If
    End If
End Sub

Sub shp_move(shp As Shape, r As Range)
    With r
        shp.Top = .Top + (.Height - shp.Height) / 2
        shp.Left = .Left + (.Width - shp.Width) / 2
    End With
End Sub

多分結果は得られると思いますがコード内コメントなどを付けて
改修時に忘れないようにしておく方が良いかもです。
シェイプの移動だけなので別に良いかも知れませんが
他のシートをいじるので制御系のコードも入れておいた方が良いかも知れません。

ExcelのVBAコードについて教えてください。

こんにちは

こんにちは

問題はシートイベントのトリガーにあります・・いや、問題ではなく仕様なのですが・・

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング