Jsou zobrazeny jen nové odpovědi. Zobrazit všechny
Předmět Autor Datum
Jistym resenim je vyuziti udalostnich procedur listu Worksheet_Change a Worksheet_SelectionChange. N… poslední
navstevnik 23.11.2008 08:05
navstevnik

Jistym resenim je vyuziti udalostnich procedur listu Worksheet_Change a Worksheet_SelectionChange.
Na vlozenem novem listu lze pak zaznamenat uzivatelske zmeny na konkretniho listu.
Nasledujici procedury mohou poslouzit jako vychodisko k dalsimu rozvinuti.
V editoru VBA, objekt konkretni list:

Option Explicit

Dim OldValue As Variant, NewValue As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Cells.Count > 1 Then ' vybran blok bunek
    ' adresa, nova hodnota leva horni, nova hodnota prava dolni
    EventLog Target.Address(0, 0), Target.Resize(1, 1).Value _
      , Target.Offset(Target.Rows.Count - 1, Target.Columns.Count - 1).Value
  Else
    If Target.HasFormula Then NewValue = Target.Formula Else _
      NewValue = Target.Value
  ' adrtesa, stara hodnota, nova hodnota
    EventLog Target.Address(0, 0), OldValue, NewValue
  ' uzivatelskym vlozenim funkce se nezmeni adresa bunky,
  ' v pripade dalsi zmeny v teto bunce je pak k dispozici OldValue:
    OldValue = NewValue
  End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.HasFormula Then OldValue = Target.Formula Else OldValue = Target.Value
  ' vybran blok bunek, adresa, stara hodnota leva horni, stara hodnota prava dolni
  If Target.Cells.Count > 1 Then _
    EventLog Target.Address(0, 0), Target.Resize(1, 1).Value _
    , Target.Offset(Target.Rows.Count - 1, Target.Columns.Count - 1).Value
End Sub

Zaznamy jsou vedeny na listu EventLog, prvni radek hlavicka: Datum, adresa bunky, stara hodnota, nova hodnota.

objekt modul:

Option Explicit

Sub EventLog(Adr As String, Par1 As Variant, Par2 As Variant)
Dim OldBlk As Range, NewBlk As Range, NewRow As Range
  Set OldBlk = Worksheets("eventlog").Range("a2:d201") ' ulozeno poslednich 200 zaznamu
  Set NewBlk = OldBlk.Offset(1, 0)
  Set NewRow = OldBlk.Resize(1, 1)
  NewBlk.Value = OldBlk.Value
  With NewRow
    .Resize(1, 4).ClearContents
    .Value = Now
    .Offset(0, 1).Value = Adr
    .Offset(0, 2).Value = Par1
    .Offset(0, 3).Value = Par2
  End With
End Sub

Pro vice jak jeden list je nutno pridat nazev listu.
Zachyceni zmen vyvolanych procedurami VBA, ovladacimi prvky,... vyzaduje doplneni vyse uvedeneho, coz je uz nad moznosti poradny.

Zpět do poradny Odpovědět na původní otázku Nahoru