シートの表示・非表示に合わせて、図形を移動できるコードを教えてください。
作業ブックに
Sub 図形移動()
Call shp_move(Worksheets("審査").Shapes("紙"), Range("L9"))
Call shp_move(Worksheets("審査").Shapes("紙報告"), Range("L12"))
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
のマクロがあります。
マクロを実行するとシート名「審査」の指定したセル値に指定の図形名の図形が移動します。
このコードに下記の条件を追加する方法を教えてください。
1.シート名「300」が表示されていると図形名「報告」がシート名「審査」のセル値「L15」に図形が移動
2.シート名「200」が表示されていると図形名「消防」がシート名「審査」のセル値「L15」に図形が移動
尚、シート名「200」「300」が同時に表示されることはありません。常にどちらかが表示されます。
又、最終的に、今回のマクロと違うマクロを統合して一つのマクロにすることもありますので、
ワークシートを「Worksheets("審査")」に設定しております。
よろしくお願いいたします。
No.4ベストアンサー
- 回答日時:
ごめんなさい
Set rr = r.Parent.Range(exisShp.TopLeftCell, shp.BottomRightCell)×
Set rr = r.Parent.Range(exisShp.TopLeftCell, exisShp.BottomRightCell)
Sub 図形移動()
Call shp_move(Worksheets("審査").Shapes("紙"), Range("L9"))
Call shp_move(Worksheets("審査").Shapes("紙報告"), Range("L12"))
End Sub
これからも呼ぶの ? なら
Sub 図形移動()
Call Module1.shp_move(Worksheets("審査").Shapes("紙"), Worksheets("審査").Range("L9"))
Call Module1.shp_move(Worksheets("審査").Shapes("紙報告"), Worksheets("審査").Range("L12"))
End Sub
Module1はshp_moveを書いたモジュール名
環境を作るのが面倒なのでデバッグは行っていません。他にもエラーが発生するかもで参考程度で・・
レスポンスの保証は出来ませんが、もし解らないエラーが出たららエラー番号と変更した部分、止まったコードを教えてください。
シェイプがない場合などのエラー処理は必須なので加えてください
No.3
- 回答日時:
こんにちは
>報告>消防 のシェイプはどこにあるの?
審査シートで良ければ
>最終的に、今回のマクロと違うマクロを統合して
どの様に統合されるのか分かりませんけれど・・・
ThisWorkbookモジュールを使うやり方で
ThisWorkbookモジュールに
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Application.EnableEvents = False
With Worksheets("審査")
If Sh.Name = "300" Then Call Module1.shp_move(.Shapes("報告"), .Range("L15"))
If Sh.Name = "200" Then Call Module1.shp_move(.Shapes("消防"), .Range("L15"))
.Select
.Range("A1").Select
End With
Sh.Select
Application.EnableEvents = True
End Sub
標準モジュールに(例 Module1 )
Sub shp_move(shp As Shape, r As Range)
Dim rr As Range, exisShp As Shape
For Each exisShp In r.Parent.Shapes
Set rr = r.Parent.Range(exisShp.TopLeftCell, shp.BottomRightCell)
If Not Intersect(rr, r) Is Nothing Then
exisShp.Top = r.Offset(2).Top
exisShp.Left = r.Offset(, 3).Left
End If
Next
With r
shp.Top = .Top + (.Height - shp.Height) / 2
shp.Left = .Left + (.Width - shp.Width) / 2
End With
End Sub
勝手に解釈したところ
L15セルにすでにシェイプがある場合、2行下3列右に移動しています
シェイプが選択状態にならないようにA1セルを選択
既存の
Sub shp_move(shp As Shape, r As Range)
は、重複する可能性があるので対処してください
意図するところと違えば、忘れてください
No.1
- 回答日時:
ご自身で考えてみた方が良いのでは?
Sub 図形移動()
は審査シートがACTIVEでないとエラー、というか意図しない場所に図形が移動するかもしれませんよ。
Call shp_move(Worksheets("審査").Shapes("紙報告"), Range("L12"))
プロシージャ shp_move の第二引数に渡している Range("L12") でシートを指定していないため、ACTIVEなシート、つまりレイアウトが異なるかもしれない別シートのL12の位置で計算されて移動するのでは?
Worksheets の Visiale プロパティでシートの表示または非表示の状態は調べられるので、後は IF で条件分岐させます。
shp_moveでシートに注意しながら引数を渡せば良いでしょう。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・一回も披露したことのない豆知識
- ・これ何て呼びますか
- ・チョコミントアイス
- ・初めて自分の家と他人の家が違う、と意識した時
- ・「これはヤバかったな」という遅刻エピソード
- ・これ何て呼びますか Part2
- ・許せない心理テスト
- ・この人頭いいなと思ったエピソード
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・あなたの習慣について教えてください!!
- ・ハマっている「お菓子」を教えて!
- ・高校三年生の合唱祭で何を歌いましたか?
- ・【大喜利】【投稿~11/1】 存在しそうで存在しないモノマネ芸人の名前を教えてください
- ・好きなおでんの具材ドラフト会議しましょう
- ・餃子を食べるとき、何をつけますか?
- ・あなたの「必」の書き順を教えてください
- ・ギリギリ行けるお一人様のライン
- ・10代と話して驚いたこと
- ・家の中でのこだわりスペースはどこですか?
- ・つい集めてしまうものはなんですか?
- ・自分のセンスや笑いの好みに影響を受けた作品を教えて
- ・【お題】引っかけ問題(締め切り10月27日(日)23時)
- ・大人になっても苦手な食べ物、ありますか?
- ・14歳の自分に衝撃の事実を告げてください
- ・架空の映画のネタバレレビュー
- ・「お昼の放送」の思い出
- ・昨日見た夢を教えて下さい
- ・ちょっと先の未来クイズ第4問
- ・【大喜利】【投稿~10/21(月)】買ったばかりの自転車を分解してひと言
- ・メモのコツを教えてください!
- ・CDの保有枚数を教えてください
- ・ホテルを選ぶとき、これだけは譲れない条件TOP3は?
- ・家・車以外で、人生で一番奮発した買い物
- ・人生最悪の忘れ物
- ・【コナン30周年】嘘でしょ!?と思った○○周年を教えて【ハルヒ20周年】
- ・10秒目をつむったら…
- ・人生のプチ美学を教えてください!!
- ・あなたの習慣について教えてください!!
- ・都道府県穴埋めゲーム
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excel組織図を横に展開する方法...
-
エクセルで図形やワードアート...
-
Office365 のExcelでオブジェク...
-
Excel に貼り付けた図形が、勝...
-
word2010 SmartArtで連絡網作...
-
エクセル マクロで、選択してい...
-
ベクターワークスで線を複写
-
指定範囲内で図形等を削除する...
-
EXCEL セルに配置した図形ごと参照
-
Excel 図形を移動させると複写...
-
クラリスワークスのようなソフト
-
イラレCSでハッチ効果ありますか?
-
エクセル コマンドボタン 丸...
-
jwCAD 登録した図形を呼び出し...
-
図形の特定の色を一括置換する...
-
ワードの図形をコピー&ペイス...
-
マクロで選択した図形の選択状...
-
ワードで大量の図形を一括でグ...
-
パワーポイント(2016)、線を...
-
Excel2007で「サイズとプロパテ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで図形やワードアート...
-
Office365 のExcelでオブジェク...
-
指定範囲内で図形等を削除する...
-
word2010 SmartArtで連絡網作...
-
Excel組織図を横に展開する方法...
-
Excel に貼り付けた図形が、勝...
-
エクセル マクロで、選択してい...
-
Excel 図形を移動させると複写...
-
jwCAD 登録した図形を呼び出し...
-
ワードの図形をコピー&ペイス...
-
オートシェイプで任意のドーナ...
-
マウスで選択した図形のみVBAで...
-
マクロで選択した図形の選択状...
-
パワーポイント(2016)、線を...
-
EXCEL セルに配置した図形ごと参照
-
エクセル コマンドボタン 丸...
-
PowerPoint2013で、図形の枠線...
-
ベクターワークスで線を複写
-
ワードで大量の図形を一括でグ...
-
Excel2007で「サイズとプロパテ...
おすすめ情報
いつも回答ありがとうございます。
下記のコードを設定しましたが、
Sub 図形移動()
Call shp_move(Worksheets("審査").Shapes("紙"), Range("L9"))
Call shp_move(Worksheets("審査").Shapes("紙報告"), Range("L12"))
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Application.EnableEvents = False
With Worksheets("審査")
If Sh.Name = "300" Then Call Module1.shp_move(.Shapes("報告"), .Range("L15"))
If Sh.Name = "200" Then Call Module1.shp_move(.Shapes("消防"), .Range("L15"))
.Select
.Range("A1").Select
End With
Sh.Select
Application.EnableEvents = True
End Sub
Sub shp_move(shp As Shape, r As Range)
Dim rr As Range, exisShp As Shape
For Each exisShp In r.Parent.Shapes
Set rr = r.Parent.Range(exisShp.TopLeftCell, shp.BottomRightCell)
If Not Intersect(rr, r) Is Nothing Then
exisShp.Top = r.Offset(2).Top
exisShp.Left = r.Offset(, 3).Left
End If
Next
With r
shp.Top = .Top + (.Height - shp.Height) / 2
shp.Left = .Left + (.Width - shp.Width) / 2
End With
End Sub
以上ですが、
「Set rr = r.Parent.Range(exisShp.TopLeftCell, shp.BottomRightCell)」の部分が黄色くなりエラーメッセージが出てしまします。
解決方法をよろしくお願いいたします。