vba どこを直していいかわかりません。

'//シートモジュール
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

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

No.1 回答者： WindFaller 回答日時： 2017/05/15 17:30

作者です。

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

そうすると、一番良い方法は、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