• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

VBA code voor opslaan van cel wijzigingen in Log bestand

Status
Niet open voor verdere reacties.
S

samabert

Gebruiker
Lid geworden
27 mrt 2010
Berichten
301
Hallo,

VBA code gevonden die wijzigingen in cellen op verschillende werkbladen opslaat in een apart blad.

De code die hier voor zorgt:
Code: 
Dim PreviousValue

Private Sub Worksheet_Change(ByVal Target As Range)
   
    If Target.Value <> PreviousValue Then
        Application.EnableEvents = False


        Sheets("Log").Cells(65000, 1).End(xlUp).Offset(1, 0).Value = _
        Range("A7") & "   " & Date & "   " & Time & " changed cell:    " & ActiveSheet.Name & "  " & Target.Address(False, False) _
                                                                     & "  from   " & PreviousValue & "  to    " & Target.Value

        Application.EnableEvents = True

    End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    PreviousValue = Target.Value

End Sub

Dit werkt, maar ik zou graag een aanpassing willen, indien dit natuurlijk mogelijk is.

Mijn vraag: de wijzigen in de cellen worden nu opgeslagen in tekst vorm op het blad " Log ".
Kan dit aangepast worden dat zoals naam, datum, tijd enz. in aparte kolommen komen te staan in de tabel op blad Log?

Alvast bedankt.
Marc
 

Bijlagen

  • Test.xlsm
    30,9 KB · Weergaven: 79
Alleen deze; de selection_change() code kan je verwijderen.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
        nieuw = Target.Value
       Application.Undo
       old = Target.Value
       Application.Undo
  If nieuw <> old Then
        Sheets("Log").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 7) = Array(Range("A7"), Date, Time, ActiveSheet.Name, Target.Address(0, 0), old, Target.Value)
  End If
        Application.EnableEvents = True
End Sub

Je kan ook alle codes verwijderen en onderstaande in Thisworkbook .plaatsen.
Code: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim nieuw, old
Application.EnableEvents = False
 nieuw = Target.Value
 Application.Undo
 old = Target.Value
 Application.Undo
  If nieuw <> old Then
        Sheets("Log").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 7) = Array(Range("A7"), Date, Time, sh.Name, Target.Address(0, 0), old, Target.Value)
  End If
        Application.EnableEvents = True
End Sub
 
Laatst bewerkt:
Harry,

De code voor in Thisworkbook werkt super :thumb:

Ik heb de verschillende mogelijkheden getest en alles werkt.
Toch wel een kleine extra vraag i.v.m. met iets wat mij opgevallen is, als je de inhoud cel per cel wist is er geen probleem, maar als je meerder cellen selecteert in één keer en dan wissen krijg je een fout op:
Code: 
If nieuw <> old Then

Ik dacht dit op te lossen door volgende code ook te gebruiken in Thisworkbook, in een testblad en alleen met deze code werkt dit maar ik krijg dit niet geïntegreerd in jouw code.
Code: 
If Selection.Cells.Count > 1 Then
        MsgBox "Please select only one cell."
        ActiveCell.Select
    End If

Kan dit ook aangepast worden dat multi select niet werkt?


Enorm bedankt voor de oplossing van het wegschrijven naar de tabel. :d

Marc
 
Code: 
If Target.Count > 1 Then
    MsgBox "Please select only one cell."
    ActiveCell.Select
End If
 
Test het zo maar eens.
Code: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim nieuw, old
[COLOR=#0000ff]If Target.Count = 1 Then[/COLOR]
Application.EnableEvents = False
 nieuw = Target.Value
 Application.Undo
 old = Target.Value
 Application.Undo
  If nieuw <> old Then
        Sheets("Log").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 7) = Array(Range("A7"), Date, Time, Sh.Name, Target.Address(0, 0), old, Target.Value)
  End If
        Application.EnableEvents = True
[COLOR=#0000ff] End If[/COLOR]
End Sub
 
@ edmoor,

Jij ook bedankt voor de code.
Doch als ik jouw code invoeg krijg ik terug de fout op :
Code: 
If nieuw<>old Then

Sorry dat ik het niet helemaal duidelijk uitgelegd heb, maar het is de bedoeling dat als er meerder cellen worden geselecteerd om de inhoud te wissen dat dit niet kan, alleen cel per cel omdat de log alleen cel per cel wijzigingen kan bijhouden.

Mvg.
Marc
 
@ Harry,

Bijna goed, uitvoerig getest en je krijgt geen fout meer bij de selectie van meerder cellen en wissen van de inhoud, maar je kan nog altijd effectief die multi-selectie wissen en dat zou dus niet mogen omdat die wijzigingen dan niet worden opgeslagen in de log, als je cel per cel wijzigt komt dit wel in de log te staan. Dat is eigenlijk de bedoeling, dat alles terug te vinden is in de log.

Mijn excuses dat ik niet direct de juiste uitleg heb gegeven. Denkt je dat dit nog aan te passen is?

Mvg.
Marc
 
Of er 1 of meerdere cellen zijn geselecteerd controleer je met de code die ik liet zien:
If Target.Count > 1 Then
 
Ja, je hebt gelijk maar als je de message box weg klikt dan zou de multi-selectie moeten stoppen en terug gaan naar de active cel.
Maar als je de box weg klikt krijg je de fout.
Zie ik dat verkeerd of voeg ik de code op een verkeerde manier in?
 
Code: 
If Target.Count > 1 Then
    MsgBox "Please select only one cell."
    ActiveCell.Select
[COLOR="#FF0000"]    Exit Sub[/COLOR]
End If
 
Zet je document op "delen" modus, dan kan je gebruik maken van de ingebouwde log functionaliteiten. Heb je ook geen VBA nodig,
 
Of anders:
Code: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim nieuw, old
Application.EnableEvents = False
[COLOR=#0000ff] If Target.Count > 1 Then[/COLOR]
[COLOR=#0000ff]  Application.Undo[/COLOR]
[COLOR=#0000ff]  Application.EnableEvents = True[/COLOR]
[COLOR=#0000ff]  Exit Sub[/COLOR]
[COLOR=#0000ff] End If[/COLOR]


 nieuw = Target.Value
 Application.Undo
 old = Target.Value
 Application.Undo
  If nieuw <> old Then
        Sheets("Log").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 7) = Array(Range("A7"), Date, Time, Sh.Name, Target.Address(0, 0), old, Target.Value)
  End If
        Application.EnableEvents = True
End Sub
 
edmoor, dit is wat ik er van gemaakt heb, geen fout en opslaan van cel per cel, maar de multi-selectie is na het ok klikken van message box effectief gewist.
Waarschijnlijk doe ik iets fout.

Code: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim nieuw, old

    If Target.Count > 1 Then
        MsgBox "Please select only one cell."
        ActiveCell.Select
        Exit Sub
    End If

    Application.EnableEvents = False
    nieuw = Target.Value
    Application.Undo
    old = Target.Value
    Application.Undo
    If nieuw <> old Then
        Sheets("Log").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 7) = Array(Range("A7"), Date, Time, Sh.Name, Target.Address(0, 0), old, Target.Value)

        Application.EnableEvents = True
    End If
End Sub
 
Dat komt door die ActiveCell.Select
Haal die eruit als je de multiselect niet wilt wissen.
 
@Ginger,

Bedankt voor de tip, dit ken ik niet maar ik ga het zeker opzoeken en bestuderen.
Hetgeen ik al gekregen heb van code doet het zeer goed tot hiertoe, enkel op dit klein puntje nog.
De log staat op een verborgen blad zodat niemand daaraan iets kan wijzigen.

Mvg.
Marc
 
@ edmoor


ActiveCell.Select er uit verwijderen geeft nog niet het gewenste resultaat.
Ondertussen de code van HSV getest en die doet het.
Toch nog eens bedankt voor jouw input.

Mvg.
Marc
 
Dan begriijp ik niet wat je wilt bereiken met het niet toestaan van een multiselect.
 
Harry,

:thumb: het werkt helemaal!
Multi-select en multi-wissen inhoud kan nu niet meer uitgevoerd worden.

Heel erg bedankt voor je hulp!

Mvg.
Marc
 
Laatst bewerkt:
edmoor,

Het gaat over een blad waarop verlof kan ingevuld worden, maar ook gewist en gewijzigd worden.
Het werkboek dat nu in gebruik is (via inloggen op naam) maakt nadat iemand iets gewijzigd heeft en deze persoon sluit het werkboek een kopie naar een extern bestand. Dit gaat over techniekers in 3 ploegen systeem. Indien iemand iets verkeerd invult en dat komt voor dan was het vroeger, op de papieren versie, soms de discussie wie heeft dit gedaan.
Nu kan nagezien worden wie wat gedaan heeft. Maar doordat er veel voorwaardelijk opmaak in zit en telkens trager en trager wordt wou ik het werkboek op een andere manier aanpakken door niet telkens een kopie onder een kopie te plaatsen in het extern bestand maar juist een enkele kopie. Maar dan moest wel op een andere manier gecontroleerd kunnen worden of iemand een verkeerde aanpassing gemaakt heeft. Daarom deze code.

Ik wou het toch nog even proberen uit te leggen want via jullie hulp hier ben ik al ver gekomen en dankbaar voor.

Mvg.
Marc
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan