| |
▼β さん：
>▼かず さん：
>
>>7)キーがマッチする行や挿入先の行が風名などの場合は
>風名 とは？
申し訳ありません。風名ではなく不明でした。申し訳ありません。
言いたかったのは、以下の点です。
7)更新の場合に変更元とキーがマッチする行がマスターリストに存在しない
挿入の場合に、更新元リストで挿入位置を示す行に該当する行が、マスター
リストに存在しない等、イレギュラー状態の場合は、挿入対象行はマスター
リストの一番最後の部分に挿入し、1列目にエラーの理由を書き込む。
>>サンプルコードの解説を補足します
>これを見るために、井川さんの書式を購入しなければいけないのですか？
サンプルコード(私が追記した部分は★印を記載
' 井川はるき さんのサンプルコード
’***************************************
' クラスモジュール clsRowsInsertEvent
' ***************************************
Public Event RowsInsert(Cancel As Boolean, InsRow As Long) ’★ InsRow を引数に追加 by かず
Public Sub CheckRowsInsert(ByVal mySht As Worksheet)
Static myRow As Range
Dim myInsRow As Long ' ★ 行を挿入した行番号を格納するための変数
Dim myCancel As Boolean
Dim w_FndRng As Range
Const TopRow As Integer = 29 ' ★ 作業列２ 行を挿入した行番号を格納するための変数
Const SeqCol As Integer = 65 ' ★ 作業列２の列番号の変数
Const EdaNum As Integer = 66 ' ★ 作業列２の拡張 枝番を格納するための行
Dim i As Long ’★ 制御変数
If mySht Is Nothing Then Exit Sub
With mySht
If Not myRow Is Nothing Then
On Error Resume Next
myInsRow = myRow.Row
If Err().Number <> 0 Then
’単純な行の挿入の場合、SeqCol列の空白を探す
Set w_FndRng = Range(Cells(TopRow, SeqCol), Cells(Rows.Count, SeqCol).End(xlUp)).Find("", , xlValues, xlWhole, xlByRows, xlNext)
If Not w_FndRng Is Nothing Then
' 単純に行挿入された場合 SeqCol列のどこかには""空白のセルがある
myInsRow = w_FndRng.Row
Else
' コピーして挿入 の場合、作業列２には 元の行の値が入っている
i = TopRow
Do While (i < Rows.Count)
If Cells(i, EdaNum) > 1 Then
myInsRow = i
Exit Do
End If
i = i + 1
Loop
End If
RaiseEvent RowsInsert(myCancel, myInsRow)
If myCancel Then
Application.Undo
End If
End If
End If
Set myRow = .Rows(.Rows.Count)
End With
End Sub
’***************************************
' ' ThisWorkbook
' ***************************************
Private Declare Function SetTimer Lib "user32" ( _
ByVal Hwnd As Long, ByVal nIDEvent As Long _
, ByVal uElapse As Long, ByVal lpTimerFunc As Long) _
As Long
Private Declare Sub KillTimer Lib "user32" ( _
ByVal Hwnd As Long, ByVal nIDEvent As Long)
Private WithEvents myRowsInsertEventClass As clsRowsInsertEvent
Private myTimerId As Long
Private Sub myRowsInsertEventClass_RowsInsert(Cancel As Boolean, myInsRow As Long)
'
'★ 作業列１ 時刻取得して タイムスタンプをとる(予定)
'★ 作業列２ シーケンシャル番号を格納する(予定)
MsgBox myInsRow & "行に挿入されました" ’★ 挿入位置を確認するためのMsgBoxを出力
Cancel = MsgBox("行が挿入されました。" & vbCrLf _
& "キャンセルしますか？", vbInformation Or vbYesNo) = vbYes
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim myRes As VbMsgBoxResult
If Not Saved Then
myRes = MsgBox("'" & Name & "' への変更を保存しますか？" _
, vbExclamation Or vbYesNoCancel)
If myRes = vbYes Then
Save
ElseIf myRes = vbNo Then
Saved = True
Else
Cancel = True
Exit Sub
End If
End If
KillTimer 0&, myTimerId
Set myRowsInsertEventClass = Nothing
End Sub
Private Sub Workbook_Open()
myTimerId = SetTimer(0&, 0&, 0&, AddressOf TimerProc)
End Sub
Public Property Get RowsInsertEventClass() As clsRowsInsertEvent
If myRowsInsertEventClass Is Nothing Then
Set myRowsInsertEventClass = New clsRowsInsertEvent
End If
Set RowsInsertEventClass = myRowsInsertEventClass
End Property
'***********************************************************
' 標準モジュール
'***********************************************************
Sub TimerProc(ByVal Hwnd As Long, ByVal uMsg As Long _
, ByVal idEvent As Long, ByVal dwTime As Long)
On Error Resume Next
ThisWorkbook.RowsInsertEventClass.CheckRowsInsert Sheet3 ’★井川さんのオリジナルは 引数Sheet1
End Sub
|
|
かず
- 16/3/27(日) 2:25 -
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
