'//シートモジュール
Private Sub Worksheet_Activate()
SettingKeys True
End Sub


Private Sub Worksheet_Deactivate()
'設定解除
SettingKeys False
End Sub

Sub OnEnterKeyMoving()
'★設定はここでします。
If Not ActiveSheet.Parent Is Me.Parent Then
SettingKeys False
Else
Select Case ActiveCell.Address(0, 0)
Case "B6": Range("D6").Select
Case "D6": Range("H6").Select
Case "H6": Range("K6").Select
Case "K6": Range("L6").Select
Case "L6": Range("O6").Select
Case "O6": Range("B8").Select
Case "B8": Range("F8").Select
Case "F8": Range("C10").Select
Case Else: ActiveCell.Offset(1).Activate
End Select
End If
End Sub


Sub SettingKeys(flg As Boolean)
If flg Then
Application.OnKey "~", Me.Name & ".OnEnterKeyMoving"
Application.OnKey "{ENTER}", Me.Name & ".OnEnterKeyMoving"
'MsgBox "キーを設定しました"
Else
Application.OnKey "{ENTER}"
Application.OnKey "~"
'MsgBox "キーを解除しました"
End If
End Sub


'-------------
'設定したシート名を入れる
'ThisWorkbook モジュール
Private Sub Workbook_Deactivate()
Dim sheetname As String


sheetname = Sheets(1).Name
Worksheets(sheetname).SettingKeys False
End Sub


Private Sub Workbook_Activate()
Dim sheetname As String


sheetname = Sheets(1).Name
Worksheets(sheetname).SettingKeys True
End Sub

エンターキーで指定したセルに移動するプログラムなのですがシート名を変更すると
動かなくなってしまいます。
どこを変更したらよいでしょうか?
分かる方いたらよろしくお願いします。

A 回答 (1件)

作者です。



たぶん、私の想像があっていれば、汎用的にお使いになりたいわけですね。
そういう指摘を受ければ、ごもっともです。

そうすると、一番良い方法は、Class からインスタンスを起こすことですね。
どのシートでも、使うようにするなら、以下のようなClass にしてあげます。
起動は、Aut_Open で、一旦閉じて開ければ、自動設定になっています。

最初にClass モジュールの挿入

'//標準モジュール
Public myClass As Class1
Public ShName As String
Sub Auto_Open()
'これは全体的にはアドイン式になっている
Dim sh As Worksheet
Set myClass = New Class1

ShName = "Sheet3" 'シート名を入れる
Set sh = Worksheets(ShName)

Set myClass.clsWorkbook = ThisWorkbook 'ここも変更が可能
Set myClass.clsApp = Excel.Application
Set myClass.clsWorksheet = sh
SettingKeys True
End Sub

Sub SettingKeys(flg As Boolean)
 With myClass
 If flg Then
  .clsApp.OnKey "~", "EnterMove" '半角の~波線
  .clsApp.OnKey "{ENTER}", "EnterMove"
  'MsgBox "キーを設定しました"
 Else
  .clsApp.OnKey "{ENTER}"
  .clsApp.OnKey "~", "" '半角の~波線
  'MsgBox "キーを解除しました"
 End If
End With
End Sub
Sub EnterMove()
 myClass.OnEnterKeyMoving
End Sub

'//Class1モジュール

Public WithEvents clsApp As Excel.Application
Public WithEvents clsWorksheet As Worksheet
Public WithEvents clsWorkbook As Workbook

Private Sub clsWorksheet_Activate()
 SettingKeys True
End Sub


Private Sub clsWorksheet_Deactivate()
'設定解除
 SettingKeys False
End Sub

Sub OnEnterKeyMoving()
'★設定はここでします。
 If Not ActiveWorkbook Is clsWorkbook Then
  SettingKeys False
 ElseIf clsWorksheet.Name <> ActiveSheet.Name Then
  SettingKeys False
 Else
  Select Case ActiveCell.Address(0, 0)
  Case "B6": Range("D6").Select
  Case "D6": Range("H6").Select
  Case "H6": Range("K6").Select
  Case "K6": Range("L6").Select
  Case "L6": Range("O6").Select
  Case "O6": Range("B8").Select
  Case "B8": Range("F8").Select
  Case "F8": Range("C10").Select
  Case Else: ActiveCell.Offset(1).Activate
  End Select
  
 End If
End Sub


'-------------
'設定したシート名を入れる
Private Sub clsWorkbook_Deactivate()
  SettingKeys False
End Sub

Private Sub clsWorkbook_Activate()
  SettingKeys True
End Sub
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A

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