AW: Zellwerte kopieren kopieren
20.09.2013 10:04:44
Bastian
Hallo nou,
anscheinend bastelst Du noch immer an Deinem Changelog. Das kann hier natürlich niemand wissen, weil Du ständig einen neuen Thread öffnest.
Hier mal der aktualisierte Code:
Option Explicit
Dim lngRow As Long
Dim intYesNo As Integer
Dim strGrund As String
Dim strAlterWert As String
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
intYesNo = MsgBox("Möchten Sie die Änderung übernehmen?", vbYesNo, "Änderungsabfrage")
Select Case intYesNo
Case 6
Do
strGrund = InputBox("Bitte Änderungsgrund angeben", "Änderungsgrund")
Loop Until (strGrund "") 'Eingabe erzwingen
' Changelog in Tabelle3 ausfuellen
With Worksheets("Tabelle3")
lngRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(lngRow, 1).Value = Target.Address(False, False)
.Cells(lngRow, 2).Value = Cells(Target.Row, 1).Value
.Cells(lngRow, 3).Value = strAlterWert
.Cells(lngRow, 4).Value = Target.Value
.Cells(lngRow, 5).Value = Application.UserName
.Cells(lngRow, 6).Value = Now
.Cells(lngRow, 7).Value = strGrund
End With
Case Else
'Falls bei der Abfrage "Nein" gewaehlt wird, wird der alte Wert wieder eingetragen ( _
Aenderung verworfen)
Application.EnableEvents = False
Target.Value = strAlterWert
Application.EnableEvents = True
Exit Sub
End Select
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Verhindern, dass mehr als eine Zelle selektiert wird
On Error GoTo ErrorExit
Application.EnableEvents = False
ActiveCell.Select
ErrExit:
Application.EnableEvents = True
'Wert der ausgewaehlten Zelle merken, um im Changelog den alten Zellwert zu dokumentieren
strAlterWert = Target.Value
ErrorExit:
End Sub
Die Tabelle mit dem Changelog sieht dann so aus:
| | A | B | C | D | E | F | G |
| 1 | Zelladresse | ID (Wert aus Spalte A) | alter Zellwert | neuer Zellwert | geändert von | Änderungsdatum / Zeit | Änderungsgrund |
| 2 | A2 | | | Neuer Text | Mustermann, Max | 18.09.2013 09:29 | nur so |
| 3 | C1 | Hallo | | Neuer Text | Humpert, Bastian | 20.09.2013 09:55 | nur so |
Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Gruß, Bastian