Stránka 1 z 1

Makro pro zápis historie

Napsal: 15 úno 2016 22:52
od Woodpecker
Ahoj,
potřeboval bych makro pro sledování změn u odemčených buněk v přiloženém příkladu, tak aby k zápisu změn docházelo na zamčeném druhém listu. Bohatě postačuje datum, stará a nová hodnota buňky. Sledování změn mi nevyhovuje, nejedná se o sdílený dokument. Dnes jsem nacházel makra pro sledování změn u sdílených dokumentů nebo pro mě nevyužitelné. Používám MSO 2007. Díky Moc za pomoc.

Heslo: 123
Je to reálné nebo absolutní nesmysl?

Re: Makro pro zápis historie  Vyřešeno

Napsal: 19 úno 2016 18:26
od cmuch
Toto vlož do modulu listu Data

Kód: Vybrat vše

Dim OldVal, Pozice

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    OldVal = Target
    Pozice = Target.Address
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range, i, radek
    Dim JmenoPC, JmenoExcel
   
    Set KeyCells = Range("A1:AZ9999") ' *** hlídaná oblast ************

    JmenoPC = Environ("UserName")
    JmenoExcel = Application.UserName
    NewVal = Target.Value
                       
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
        With Sheets("Zmeny")
            .Protect UserInterfaceOnly:=True
            radek = 1   'nastaveni radek jako 1
            For i = 1 To .Cells(.Cells.Rows.Count, "A").End(xlUp).Row + 1
                If .Cells(i, 1) <> "" Then
                    radek = radek + 1
                End If
            Next
   
            .Cells(radek, 1).Value = Format$(Now, "yyyy/mm/dd hh:nn:ss")
            .Cells(radek, 2).Value = JmenoPC
            .Cells(radek, 3).Value = JmenoExcel
            .Cells(radek, 4).Value = Pozice
            .Cells(radek, 5).Value = OldVal
            .Cells(radek, 6).Value = NewVal
        End With
   
    End If
End Sub