Excel VBAで1時的に右クリックを使いたい

2023/09/07 04:47

このQ&Aのポイント

Excel VBAを使用して、30枚のシートの表を一括で変更したいです。しかし、各シートには特定のコードが入っているため、通常の右クリック機能が使用できません。シートの変更を行うために一時的に右クリックを使用する方法があるでしょうか？
Excel VBAを使用して、30枚のシートの表を一括で変更したいです。ただし、各シートには特定のコードが含まれているため、通常の右クリック機能は使用できません。シートの変更が完了するまで一時的に右クリックを使用する方法を教えてください。
Excel VBAを使用して、30枚のシートの表を一括で変更したいです。ただし、各シートには特定のコードがあるため、通常の右クリック機能が使用できません。シートの変更が完了するまで一時的に右クリックを使用する方法はありますか？

ベストアンサー

Excel VBA で1時的に右クリックを使いたい

2019/09/07 17:06

30枚ほどのシートの表を一挙に変更したいです。ところが、各シートに次のコードが入っているため、右クリックしてコピーとか一切使えません。各シートの変更ができるまで、右クリック使いたいです。何か方法ありませんでしょうか？ ' 画面の一番上表示 Dim hr As Range Set hr = Range("A1") '左上隅セルを設定 ActiveWindow.ScrollRow = hr.Row '行の一番上にスクロール ActiveWindow.ScrollColumn = hr.Column '列の一番左にスクロール End Sub Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) Cancel = True 'プロシージャ終了後に表示されるショートカットメニューの非表示 If Target.Row > 14 And Target.Row < 45 And Target.Column > 13 And Target.Column < 15 Then 明細入力フォーム.Show End If If Target.Row > 36 And Target.Row < 45 And Target.Column > 1 And Target.Column < 3 Then Call ShowCalendarFromRange2(Target) End If If Target.Row > 36 And Target.Row < 45 And Target.Column > 3 And Target.Column < 5 Then Call ShowCalendarFromRange2(Target) End If If Target.Row > 36 And Target.Row < 45 And Target.Column > 5 And Target.Column < 7 Then Call ShowCalendarFromRange2(Target) End If If Target.Row > 36 And Target.Row < 45 And Target.Column > 8 And Target.Column < 10 Then Call ShowCalendarFromRange2(Target) End If If Target.Row > 36 And Target.Row < 45 And Target.Column > 2 And Target.Column < 4 Then UserForm3.Show End If If Target.Row > 36 And Target.Row < 45 And Target.Column > 4 And Target.Column < 6 Then UserForm3.Show End If If Target.Row > 36 And Target.Row < 45 And Target.Column > 6 And Target.Column < 8 Then UserForm3.Show End If If Target.Row > 36 And Target.Row < 44 And Target.Column > 9 And Target.Column < 11 Then UserForm3.Show End If End Sub

aitaine
お礼率43% (170/393)

Excel（エクセル）
回答数5
ありがとう数6

みんなの回答 （5）
専門家の回答

質問者が選んだベストアンサー

ベストアンサー

m3_maki
ベストアンサー率64% (295/459)

2019/09/08 10:42 回答No.5

イミディエイトウィンドウで Application.EnableEvents=False を実行してから編集作業をしてください。編集終了後 Application.EnableEvents=True を実行。

質問者

お礼 2019/09/09 10:44

いま、あなた様のコード入力で、完璧にしかも早く各シートの表を変更することができました。心からお礼を申し上げます。本当にありがとうございました。

その他の回答 (4)

unokwave
ベストアンサー率58% (966/1654)

2019/09/07 20:16 回答No.4

モジュールの関数宣言より前に Public Const SHIFT_KEY = &H10 'Shift key code Declare Function GetKeyState Lib "USER32" (ByVal vKey As Long) As Integer と宣言しておいて、関数の先頭で If GetKeyState(SHIFT_KEY) = 0 Then Exit Sub を入れておくと、Shiftキーを押して右クリックした場合のみそのマクロを機能させられます。

kkkkkm
ベストアンサー率65% (1606/2443)

2019/09/07 18:40 回答No.3

No2の追加です。イベントをオンオフする以外にコードそのものをオフにしてしまう手もあります。添付画像のようにツールバーの上で右クリックし編集にチェックを入れます。画像のツールバーが出てきますので該当のコードをすべて選択状態にして指の絵でさしているアイコン「コメントブロック」をクリックすると、選択した行の行頭に「'」が追加されてコード全体が緑色になりそのコードが実行されなくなります。操作が終わったら該当のコードをすべて選択状態にして「コメントブロック」の右の「非コメントブロック」をクリックすると元に戻ります。

kkkkkm
ベストアンサー率65% (1606/2443)

2019/09/07 18:12 回答No.2

以下二つのコードを追加してそれぞれイベントを停止したいときに実行 Sub EventsOff() Application.EnableEvents = False End Sub 停止を再開したいときに実行 Sub EventsOn() Application.EnableEvents = True End Sub

watabe007
ベストアンサー率62% (476/760)

2019/09/07 17:56 回答No.1

>1時的に右クリックを使いたい Z1セルに1が入力されている時のみ右クリックが使えます。 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) 　　If Range("Z1").Value = 1 Then 　　　　Exit Sub 　　Else 　　　　Cancel = True 　　End If 　　If Target.Row > 14 And Target.Row < 45 And Target.Column > 13 And Target.Column < 15 Then 　　　　明細入力フォーム.Show 　　End If 　　If Target.Row > 36 And Target.Row < 45 And Target.Column > 1 And Target.Column < 3 Then 　　　　Call ShowCalendarFromRange2(Target) 　　End If '・・・・・・ '・・・・・・ '・・・・・・

関連するQ&A

シングルクリックでフォームが表示されない
windowsＸＰ　　Ｅｘｃｅｌ2000　でマクロを作成している超初心者です。あるサイトの暦で日付を入力するマクロですが、１枚のシートに 1）と　2）を併記して実験したところ正常に表示できました。 2）をシングルクリックで表示したいのですができません。なぜでしょうか？ 2）はいかにも稚拙です。もっと整理したいのですが方法が分かりません。以上２点よろしくご指導ください。 -------------------------------------------------------------------- １）シングルクリックで UserForm1を正常に起動できました。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'シングルクリックで表示 Cancel = True 'プロシージャ終了後に表示されるショートカットメニューの非表示 If Target.Row > 22 And Target.Column > 2 And Target.Column < 4 Then UserForm1.Show End If If Target.Row > 22 And Target.Column > 13 And Target.Column < 15 Then UserForm1.Show End If End Sub ------------------------------------------------------------------------- 2）ダブルクリックでしか正常に表示されません。 'Private Sub Worksheet_SelectionChange(ByVal Target As Range)’　起動しない Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) '起動した Cancel = True 'プロシージャ終了後に表示されるショートカットメニューの非表示 If Target.Row > 23 And Target.Column > 1 And Target.Column < 3 Then Call ShowCalendarFromRange2(Target) End If If Target.Row > 23 And Target.Column > 12 And Target.Column < 14 Then Call ShowCalendarFromRange2(Target) End If If Target.Row > 12 And Target.Row < 21 And Target.Column > 12 And Target.Column < 14 Then Call ShowCalendarFromRange2(Target) End If If Target.Row > 12 And Target.Row < 21 And Target.Column > 14 And Target.Column < 16 Then Call ShowCalendarFromRange2(Target) End If If Target.Row > 12 And Target.Row < 21 And Target.Column > 16 And Target.Column < 18 Then Call ShowCalendarFromRange2(Target) End If If Target.Row > 12 And Target.Row < 21 And Target.Column > 18 And Target.Column < 20 Then Call ShowCalendarFromRange2(Target) End If End Sub ----------------------------------------------------------------------- 3）'これがサイトにあった例で、これを元に上のスクリプトを作りました。 'Private Sub Worksheet_SelectionChange(ByVal Target As Range) ' 複数セル選択時は無視 ' If Target.Count <> 1 Then Exit Sub ' A列以外は無視(今回サンプルの例) ' If Target.Column <> 1 Then Exit Sub ' カレンダーフォームを起動する ' Call ShowCalendarFromRange2(Target) 'End Sub ---------------------------------------------------------------
- ベストアンサー
- Visual Basic
Excel VBAについて
Excel VBAにおいて、Sheetの選択した行によって値を表示するUserFormを変更したいと思っています。現在以下のようにしたのですが、実行すると「SubまたはFunctionが定義されていません」というエラーが表示されます。「Controls("UserForm" & x).Label1.Caption =」のところをどのようにしたらよいのでしょうか。 Private Sub CommandButton1_Click() 　　If ActiveCell.Row = 5 Then 　　　　UserForm1.Show 　　　　x = 1 　　ElseIf ActiveCell.Row = 6 Then 　　　　UserForm2.Show 　　　　x = 2 　　End If End Sub Private Sub Worksheet_Selection Change(Byval Target As Range) 　　Controls("UserForm" & x).Label1.Caption = ・・・
- ベストアンサー
- Visual Basic
エクセルコードについて
エクセルコードについて Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 　　If Target.Row >= 1 And Target.Row <= 10 And Target.Column >= 1 And Target.Column <= 10 Then 　　　　If Target.Value = "○" Then 　　　　　　Target.Value = "" 　　　　Else 　　　　　　Target.Value = "○" 　　　　End If 　　　　Cancel = True 　　End If End Sub ではセルA1～J10ですが、これをA1～A10などに変更するのにはどのようにすればよろしいでしょうか。
- 締切済み
- その他（ビジネス・キャリア）
エクセルVBAでクリックしたセルのみ書式を変えたいのです。
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) If Target.Row <= 11 And Target.Column <= 11 Then With Selection .Interior.ColorIndex = 3 .Font.ColorIndex = 2 .Font.Bold = True End With End If End Sub これで出来るのですが、問題は別のセルに移動しても書式は変ったままなのです。（当り前ですが）書式を変えるのはあくまで選択されている間だけにしたいのです。どのようにすればよいのでしょうか？エクセル９７です。
- 締切済み
- オフィス系ソフト
セルの内容更新時に実行される処理ができない
以下のように関数を設定し、実行してみたのですがCall CommonModule.testの部分で実行時エラー '424': オブジェクトが必要です。と表示され関数が実行されません。初心者なので知識が浅く、初歩的なミスかもしれませんがご教示いただければ幸いです。 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal target As Range) If target.Count = 1 Then Dim column As Integer Dim row As Integer column = target.column row = target.row If row >= 3 Then If ((column - 3) Mod 5) = 2 And column > 3 Then Call CommonModule.test 'エラー '424' オブジェクトが必要です。 End If End If End If End Sub Function test() MsgBox "test" End Function
- ベストアンサー
- Visual Basic
Excel　セルをクリックするだけで入力(エクセル2003)
http://questionbox.jp.msn.com/qa915096.html からの転載で申し訳ありません。この中で、jindonさまの方法で、２つの文字の入れ替えはできました。 ------------------------------------------------ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) With Target If .Row=1 And .Column=1 Then If .Value = "○" Then .Value = "" Else .Value = "○" End If End If End With End Sub ------------------------------------------------ そこで、例えば○△×のように、順番に３つの文字を入れ替えるにはどう記述すればよいでしょうか？よろしくお願いいたします。
- ベストアンサー
- その他MS Office製品
エクセル
何度もすみません　追加質問になります Private Sub Worksheet_SelectionChange(ByVal Target As Range) If (Intersect(Target, Range("I8:I68")) Is Nothing And _ Intersect(Target, Range("L9:Q69,S9:U69,W9:W69,Y9:AB69")) Is Nothing) Or _ (Target.Row Mod 2 = 0 And Target.Column <> Columns("I").Column) Then Else UF現金.Show End If If (Intersect(Target, Range("J8:J68")) Is Nothing And _ Intersect(Target, Range("L8:Q68,S8:U68,W8:W68,Y8:AB68")) Is Nothing) Or _ (Target.Row Mod 2 = 0 And Target.Column <> Columns("J").Column) Then Else UF預金.Show End If End Sub 最初の範囲でUF現金が開き奇数番号にUF預金を開くようにしたいのですが上の算式では思うように開きませんどこが違ってますか？
- ベストアンサー
- Excel（エクセル）
エクセルVBAについて
エクセルVBAについて下ような、最初に選択したセルに、次に選択したセルをコピーするマクロを使用しています。 Dim Frstcell As Range Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.MergeCells = False And Target.Count > 1 Then Exit Sub On Error Resume Next 'エラーを無視 If Target.Column >= 5 And Target.Column <= 35 Then 'E:AIコピー先 Set Frstcell = Target.Cells(1) ElseIf Target.Column >= 45 And Target.Column <= 46 Then 'AS:ATコピー元 If Target.Cells(1).Value = "" Then Exit Sub Target.Copy Frstcell.MergeArea End If On Error GoTo 0 'エラートラップ終了 End Sub この場合、コピー元の枠線の書式も、コピー先にコピーされてしまうのですが、書式なしでコピーするにはどうしたらよいでしょうか？よい方法がありましたら、よろしくお願いいたします。
- ベストアンサー
- その他MS Office製品
VBAエラー「スタック領域が不足しています」
C2とD2のセルに英文字を入力した時，先頭文字を大文字にするVBAを組んだのですが，いざ実行すると「スタック領域が不足しています」と出てしまいます。以下にコードを示します。 'Sheet1 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) 　　If Target.Row = 2 And Target.Column = 3 Then 　　　　Range("C2").Value = StrConv(Range("C2").Value, vbProperCase) 　　End If 　　If Target.Row = 2 And Target.Column = 4 Then 　　　　Range("D2").Value = StrConv(Range("D2").Value, vbProperCase) 　　End If End Sub なぜこのようなエラーが出るのでしょうか。考えれば考えるほど合っているように思えて仕方なくなったので，ミスがあればご指摘をおねがいします。
- ベストアンサー
- Visual Basic
エクセル2003でダブルクリック処理でエラーをしてしまう
エクセルのシートＡからＺまであります一部計算式が入っているのデーター処理が終了後にダブルクリックでコピー＆値の貼り付けで式をなくしていますが列の一部とフィルターをかけると処理ができずにエラーをしてしまい対処方法が分かりません初心者でエラーの意味すら分からないのですが選択した領域と貼り付ける領域が違うようなのですどこを直せばよいのか教えて下さい。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) Dim RangeName As String RangeName = Target.Address RangeName = Mid(RangeName, 2, 1) If RangeName = "Z" And Target = "" Then Target = "OK" Range(Cells(Target.Row, 1), Cells(Target.Row, 27)).Copy ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Range(Cells(Target.Row, 1), Cells(Target.Row, 27)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 End If End Sub 宜しくお願いします。
- 締切済み
- オフィス系ソフト