| |
みなさんおはようございます。
とりあえず昨日作りましたサンプルで、
問題がまだありそうでしたので再度アップします。
いらなさそうですけど・・・
問題は、どうもインスタンス管理が適当になっていて、
正しく作られない場合がありました。
シート切り替えるタイミングで挿入イベントが発生しない等
後、必要に応じて作るインスタンスにしたので
シート切り替えでインスタンスを消したり作ったりしないようにしました。
クラスモジュールについてやっているうちに理解不能な動きになってたので
とことん作ってみたくなりました＾＾；
'*** シートモジュール ***
Option Explicit
Dim drow As CWrapRow
'行挿入コマンドのラップ開始
Private Sub testWrapRowOn()
'既にインスタンスが生成されている場合は作らない
If drow Is Nothing Then
Set drow = GetObjEvent(Me.Name)
drow.Initialize
End If
End Sub
'行挿入コマンドのラップ終了
Private Sub testWrapRowOff()
If drow Is Nothing Then
Exit Sub
End If
drow.Terminate
Set drow = Nothing
End Sub
'内部関数呼び出し用(生成)
Function setSheet()
Call testWrapRowOn
End Function
'内部関数呼び出し用(破棄)
Function DisPose()
Call testWrapRowOff
End Function
'*** 標準モジュール ***
Sub Auto_Open()
'必要に応じてどのシートに生成するかになります。
'後、該当のシートに上記シートモジュールを事前に追加する必要があります。
Worksheets("Sheet1").setSheet
Worksheets("Sheet2").setSheet
End Sub
Sub Auto_Close()
'必要に応じてどのシートのイベントを解放するかになります。
'後、該当のシートに上記シートモジュールを事前に追加する必要があります。
Worksheets("Sheet1").DisPose
Worksheets("Sheet2").setSheet
End Sub
'CWrapRowクラスコンストラクタ引数
Function GetObjEvent(strName As String) As CWrapRow
Dim obj As CWrapRow
Set obj = New CWrapRow
Set GetObjEvent = obj
Call GetObjEvent.SetName(strName)
Set obj = Nothing
End Function
'*** CWrapRow クラスモジュール ***
Option Explicit
Public WithEvents Row As Office.CommandBarButton
Dim dcol As New Collection
Public m_SheetName As String
'コンストラクタ(必要に応じて使用してください)
Private Sub Class_Initialize()
End Sub
'行挿入ラップ開始処理
Sub Initialize()
Dim eve As New CWrapRow, ele
'Id=296 行(&R)、Id=297 列(&C)、Id=3181 挿入(&I)...、Id=3182 セル(&E)、Id=3183 挿入(&I)
For Each ele In Array(296, 297, 3181, 3182, 3183, 3185)
Set eve.Row = Application.CommandBars.FindControl(ID:=ele)
Call eve.SetName(m_SheetName) 'イベント毎にインスタンスがあるため随時シート名をセット
dcol.Add eve
Set eve = Nothing '必須
Next
End Sub
'シート名取得プロパティ
Function GetName() As String
GetName = m_SheetName
End Function
'シート名設定プロパティ
Function SetName(strName As String)
m_SheetName = strName
End Function
'行挿入ラップ終了処理
Sub Terminate()
'インスタンスを生成したシートと一致しない場合は解放しない
If ActiveSheet.Name <> GetName() Then Exit Sub
Set dcol = Nothing
End Sub
'行挿入イベント(行挿入イベントに応答するカスタムコードを記述)
Private Sub Row_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
'インスタンスを生成したシートと一致しない場合はイベントを発生させない
If ActiveSheet.Name <> GetName() Then Exit Sub
MsgBox "行挿入 " & Selection.Address '確認用
'ここで行挿入前の処理
'
CancelDefault = True '行挿入をキャンセル
Selection.EntireRow.Insert '行挿入実行
'ここで行挿入後の処理
'
End Sub
|
|
VBWASURETA
- 08/3/18(火) 11:55 -
