Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


834 / 13645 ツリー ←次へ | 前へ→

【78061】複数のシートで列の挿入を同期させたい 困っています 16/3/18(金) 19:26 質問[未読]
【78063】Re:複数のシートで列の挿入を同期させたい β 16/3/18(金) 21:05 発言[未読]

【78061】複数のシートで列の挿入を同期させたい
質問  困っています  - 16/3/18(金) 19:26 -

引用なし
パスワード
   お世話になっております。
昨日1つ問題を解決して頂いたばかりで、誠に申し訳ないのですが、
もう1度お知恵を拝借できないでしょうか。

やりたいことは、複数のシート間での列の挿入の同期です。
(Sheet1に列を挿入したら、他のシートの同じ位置にも列を挿入したい。)
右クリックのメニューに項目を表示し、項目のクリックから
動作させたいと考えております。
右クリックのメニューに、項目の追加はできております。

重要な中身のコードは、Webで検索しよさそうなものを発見したので
そちらを拝借したいと思うのですが、コードが標準モジュール用ではなく、
「ThisWorkbook」に記述する用なのです…。

これを標準モジュール用に直したいのですが、
頭の部分を色々変更しただけでは直りませんでした。。。

拝借する予定のコードは以下の通りです。


Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim RT As Long
Dim mySh As Worksheet
Dim myRow As Long

Cancel = True

myRow = Target.Row

If Sh.Name <> "Sheet1" Then Exit Sub

RT = Val(InputBox("1=挿入" & Chr(10) & Chr(13) & _
"2=削除" & Chr(10) & Chr(13) & _
"3=キャンセル"))

If RT <> 3 And RT <> 0 Then
For Each mySh In Worksheets
mySh.Select
Rows(myRow).Select
Select Case RT
Case 1
Selection.Insert Shift:=xlDown
Case 2
Selection.Delete Shift:=xlUp
Case 3
End Select
Next mySh
End If
Sh.Select
End Sub


参考書と見比べておりますが、実は大半の意味を理解できずにおります…。
少し手直しする程度では動きませんか?
もし大幅な変更が必要であれば、あきらめたいと思います。
(教えて頂くにも、あまりにも無知で申し訳ないので。。。)

私一人が使うブックであれば、忘れずにシートのグループ化を行い
作業をすれば問題ないのですが、別の人間も使用し、
その者が度々グループ化を忘れ(そして行の挿入も忘れ)る為、今回の
自動化を望んだ次第です。


以上、皆様大変お忙しいかと存じますが、
何卒ご助力の程、よろしくお願い致します。

【78063】Re:複数のシートで列の挿入を同期させたい
発言  β  - 16/3/18(金) 21:05 -

引用なし
パスワード
   ▼困っています さん:

>私一人が使うブックであれば、忘れずにシートのグループ化を行い
>作業をすれば問題ないのですが、別の人間も使用し、
>その者が度々グループ化を忘れ(そして行の挿入も忘れ)る為、今回の
>自動化を望んだ次第です。

ということなら、マクロ内で全シートをグループ化して処理。
最後にグループ化解除をしましょうか。

Sub そのメニュー()
  Dim RT As Long
  Dim w As Variant
  Dim sh As Worksheet
  Dim x As Long
  
  If ActiveSheet.Name <> "Sheet1" Then
    MsgBox "Sheet1 でのみ操作ができます"
    Exit Sub
  End If
  
  RT = Val(InputBox("1=行挿入" & Chr(10) & Chr(13) & _
            "2=行削除" & Chr(10) & Chr(13) & _
            "3=列挿入" & Chr(10) & Chr(13) & _
            "4=列削除" & Chr(10) & Chr(13) & _
            "5=キャンセル"))
            
  If RT <> 5 And RT <> 0 Then
  
    ReDim w(1 To Worksheets.Count)
    For x = 1 To Worksheets.Count
      w(x) = Worksheets(x).Name
    Next
    
    Worksheets(w).Select
    
     Select Case RT
    
      Case 1: Selection.Insert Shift:=xlDown
      Case 2: Selection.Delete Shift:=xlUp
      Case 3: Selection.Insert Shift:=xlToRight
      Case 4: Selection.Delete Shift:=xlToLeft
      
    End Select
    
    Sheets(1).Select
      
  End If
  
End Sub

834 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free