hm...
als Krücke wäre ggf. ein Vergleich zweier Datentabellen möglich
also...
abgestimmt auf Spalte C in Tabelle Test erhält diese Arbeitsmappe
z.B. ein eigenes Klassenmodul: clsExcelApp
'******************************************************************************
' Klassenmodul: clsExcelApp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'------------------------------------------------------------------------------
' beachte
'*************************************************** diesen Code in Worksheets_Open()
'Option Explicit
'Dim oKlasseExcel As clsExcelApp
'Private Sub Workbook_Open()
' Set oKlasseExcel = New clsExcelApp
' Set oKlasseExcel.ExcelWatch = Application
'End Sub
'************************************************************************************
'
Option Explicit
Public WithEvents ExcelWatch As Application
Dim oldArr() As Variant, newArr() As Variant
Private Sub ExcelWatch_SheetCalculate(ByVal Sh As Object)
Dim hit As Long
Select Case Sh.Parent.Name
Case ThisWorkbook.Name
Select Case Sh.Name
Case "Test"
newArr = MakeArr()
hit = ChkArrs()
If hit <> 0 Then _
Call MsgBox("C" & Format(hit, "#0"), vbInformation, "Änderung")
oldArr = newArr
End Select
End Select
End Sub
Private Sub ExcelWatch_WorkbookActivate(ByVal Wb As Workbook)
Select Case Wb.Name
Case ThisWorkbook.Name
newArr = MakeArr(): oldArr = newArr
End Select
End Sub
Private Function MakeArr() As Variant
Dim RngQ As Range, c As Range
On Error GoTo flaw
With Sheets("Test")
Set c = Columns(3)
Set RngQ = Range(c.Cells(1), c.Cells(c.Cells.Count).End(xlUp))
MakeArr = RngQ
End With
flaw:
On Error GoTo 0
End Function
Private Function ChkArrs() As Long
Dim x As Long
On Error GoTo flaw
For x = LBound(newArr, 1) To UBound(newArr, 1)
If newArr(x, 1) <> oldArr(x, 1) Then
ChkArrs = x: Exit For
End If
Next x
flaw:
On Error GoTo 0
End Function
und die Klasse Arbeitsmappe ein Open Ereignis
Option Explicit
Dim oKlasseExcel As clsExcelApp
Private Sub Workbook_Open()
Set oKlasseExcel = New clsExcelApp
Set oKlasseExcel.ExcelWatch = Application
End Sub
bleibt aber nur eine Krücke!
|