gibt es im Forum jemanden, der den von Franz und mir entwickelten Gedanken (s. ganz unten) zu Ende führen kann?
Danke.
Jesko
Guten Abend an alle im Forum,
habe in einem Archivthread für eine Änderungsverfolgung (mit Erzeugung eines Kommentarfelds) in "normalen" Excel-Zellen folgenden Code gefunden:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strValue As String
Dim Zelle As Range
On Error GoTo Fehler
If (Target.Column = 5 Or Target.Column = 7 Or Target.Column = 11) And Target.Count = 1 Then
With Target
If .Comment Is Nothing Then
.AddComment "Erstellt am: " & Date & " - " & Time & Chr(10) & "Erster Eintrag: " & . _
_
_
_
Value & _
" / " & Application.UserName
Else
strValue = .Comment.Text & Chr(10)
.Comment.Text strValue & Chr(10) & "Geändert am: " & Date & " - " & Time & Chr(10) & _
_
_
_
"Änderung: " _
& .Value & " / " & Application.UserName
End If
.Comment.Shape.TextFrame.AutoSize = True
End With
End If
Exit Sub
Fehler:
MsgBox "Fehler Nr. " & Err.Number & " ist aufgtreten!" & vbLf & vbLf & Err.Description
End Sub
Läßt sich so etwas auch als Änderungsverfolgung von Eintragungen in Combo-Boxen programmieren bzw. kombiniert für "normale" Zellen & Combo-Boxen in ein- und demselben Tabellenblatt?
Bin gespannt ...
Grüße
Jesko
Hallo Jesko,
für jede Combobox (aus der Symbolleiste Steuerelemente - Toolbox!)
muss du eine entsprechende Prozedur anlegen.
Dann schaut der kombinierte Code etwa wie folgt aus.
Gruß
Franz
Private Sub ComboBox1_Change()
Call KommentarAenderung(Wert:=ComboBox1.Value, Zelle:=Me.Range("D2"))
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If (Target.Column = 5 Or Target.Column = 7 Or Target.Column = 11) And Target.Count = 1 Then
Call KommentarAenderung(Wert:=Target.Text, Zelle:=Target)
'Call KommentarAenderung(Wert:=Target.Value, Zelle:=Target)
End If
End Sub
Private Sub KommentarAenderung(Wert As Variant, Zelle As Range)
'Wert ist Wert nach Änderung
'Zelle ist Zelle in die bei Wertänderung der Kommentar eingetragen werden soll
Dim strValue As String
On Error GoTo Fehler
With Zelle
If .Comment Is Nothing Then
.AddComment "Erstellt am: " & Date & " - " & Time & Chr(10) & "Erster Eintrag: " _
& Wert & " / " & Application.UserName
Else
strValue = .Comment.Text & Chr(10)
.Comment.Text strValue & Chr(10) & "Geändert am: " & Date & " - " & Time & Chr(10) _
& "Änderung: " & Wert & " / " & Application.UserName
End If
.Comment.Shape.TextFrame.AutoSize = True
End With
Exit Sub
Fehler:
MsgBox "Fehler Nr. " & Err.Number & " ist aufgtreten!" & vbLf & vbLf & Err.Description
End Sub
Hallo Franz,
dankeschön für Deine Antwort.
Beim Kompilieren meldet der Visual Basic Editor folgenden Fehler:
"Mehrdeutiger Name: ComboBox1_Change"
Dies rührt sicherlich daher, dass es in dem Gesamtcode noch ein weiteres Ereignis gibt, das über "ComboBox1_Change" ausgelöst wird.
Kann ich diese Fehlermeldung irgendwie umgehen? Zum besseren Verständnis habe ich den gesamten Code nachstehend noch einmal eingefügt. Die ComboBox findet sich in der Spalte AD (Spalte 30).
Jesko
Option Explicit
Private Zelle As Range 'Variable zum Merken des Addresse der selektierten Zelle
Private Sub ComboBox1_Change()
Dim Zeile As Long
'Aktionen nach Wertänderung der ComboBox
On Error GoTo Fehler
Application.EnableEvents = False
Zeile = Zelle.Row
If Me.ComboBox1.Value = "" Then
Zelle.ClearContents
Zelle.Select
'Formeln in Spalten AE bis AK löschen
Range(Cells(Zeile, 31), Cells(Zeile, 37)).ClearContents
Else
If Not IsNull(Me.ComboBox1.Value) Then
'KundenNr (Text aus Combobox wird in Zahl umgewandelt)
Cells(Zeile, 30).Value = Val(Me.ComboBox1.Value)
'Formeln in Spalten AE bis AK eintragen
Cells(Zeile, 31).FormulaR1C1 = _
"=IF(VLOOKUP(RC[-1],Auswahlliste,2,FALSE)=0,"""",VLOOKUP(RC[-1],Auswahlliste,2,FALSE))" 'Nr. _
_
_
Cells(Zeile, 32).FormulaR1C1 = _
"=IF(VLOOKUP(RC[-2],Auswahlliste,3,FALSE)=0,"""",VLOOKUP(RC[-2],Auswahlliste,3,FALSE))" ' _
Zusatz
Cells(Zeile, 33).FormulaR1C1 = "=VLOOKUP(RC[-3],Auswahlliste,5,FALSE)" 'Name 1
Cells(Zeile, 34).FormulaR1C1 = _
"=IF(VLOOKUP(RC[-4],Auswahlliste,6,FALSE)=0,"""",VLOOKUP(RC[-4],Auswahlliste,6,FALSE))" ' _
Name2
Cells(Zeile, 35).FormulaR1C1 = "=VLOOKUP(RC[-5],Auswahlliste,7,FALSE)" 'Strasse
Cells(Zeile, 36).FormulaR1C1 = "=VLOOKUP(RC[-6],Auswahlliste,8,FALSE)" 'PLZ
Cells(Zeile, 37).FormulaR1C1 = "=VLOOKUP(RC[-7],Auswahlliste,9,FALSE)" 'Ort
End If
End If
GoTo Beenden
Fehler:
If Err.Number = 91 Then
MsgBox "Bitte selektieren Sie zunächst eine andere Zelle!" & vbLf & _
"Diese Meldung erscheint nach dem Öffnen der Datei, wenn in der angezeigten " & _
"ComboBox direkt der Wert geändert wird ohne vorher eine andere Zelle zu selektieren."
Else
MsgBox "Fehler Nr. " & Err.Number & " ist aufgtreten!" & vbLf & vbLf & Err.Description
End If
Beenden:
Application.EnableEvents = True
End Sub
Private Sub ComboBox1_Change()
Call KommentarAenderung(Wert:=ComboBox1.Value, Zelle:=Me.Range("D2"))
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If (Target.Column = 5 Or Target.Column = 7 Or Target.Column = 11) And Target.Count = 1 Then
Call KommentarAenderung(Wert:=Target.Text, Zelle:=Target)
'Call KommentarAenderung(Wert:=Target.Value, Zelle:=Target)
End If
End Sub
Private Sub KommentarAenderung(Wert As Variant, Zelle As Range)
'Wert ist Wert nach Änderung
'Zelle ist Zelle in die bei Wertänderung der Kommentar eingetragen werden soll
Dim strValue As String
On Error GoTo Fehler
With Zelle
If .Comment Is Nothing Then
.AddComment "Erstellt am: " & Date & " - " & Time & Chr(10) & "Erster Eintrag: " _
& Wert & " / " & Application.UserName
Else
strValue = .Comment.Text & Chr(10)
.Comment.Text strValue & Chr(10) & "Geändert am: " & Date & " - " & Time & Chr(10) _
& "Änderung: " & Wert & " / " & Application.UserName
End If
.Comment.Shape.TextFrame.AutoSize = True
End With
Exit Sub
Fehler:
MsgBox "Fehler Nr. " & Err.Number & " ist aufgtreten!" & vbLf & vbLf & Err.Description
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
On Error GoTo Fehler
With Me.ComboBox1
'Auf Spalte mit Kundennummer prüfen
If Target.Column = 30 And Target.Row > 1 And Target.Cells.Count = 1 Then
Application.EnableEvents = False
Set Zelle = Target
.Value = Target.Value
.Top = Target.Top
.Left = Target.Offset(0, 1).Left
.Visible = True
Application.EnableEvents = True
Else
Set Zelle = Nothing
.Visible = False
End If
End With
GoTo Beenden
Fehler:
MsgBox "Fehler Nr. " & Err.Number & " ist aufgtreten!" & vbLf & vbLf & Err.Description
Beenden:
Application.EnableEvents = True
End Sub
Hallo Jesko,
dann muss du die Zeile
Call KommentarAenderung(Wert:=ComboBox1.Value, Zelle:=Me.Range("D2"))
an passender Stelle in deiner Prozedur einfügen.
Wahrscheinlich unmittelbar vor Zeile "Goto Benden".
Die Zelladresse für den Kommentar muss du ggf. ändern, z.B in AD2.
Die 2. Combox1_Change-Prozedur muss du wieder löschen.
Gruss
Franz
Hallo Franz,
leider erhalte ich dann folgende Fehlermeldung:
"Fehler beim Kompilieren: Sub oder Function nicht definiert".
Wie kann ich die gesamte Spalte AD als Adresse für den Kommentar festlegen?
Gruß
Jesko
Hallo Franz,
leider erhalte ich dann folgende Fehlermeldung:
"Fehler beim Kompilieren: Sub oder Function nicht definiert".
Wie kann ich die gesamte Spalte AD als Adresse für den Kommentar festlegen?
Gruß
Jesko
Hallo Jesko,
evtl. hast du die Function KommentarAenderung nicht mit in dein VBA-Projekt kopiert oder an die falsche Postion im VBA-Projekt.
Ein Kommentar ist immer an eine einzelne Zelle gebunden. Was meinst du mit "ganze Spalte AD als Adresse für den Kommentar festlegen" ?
Gruß
Franz
Hallo Franz,
sei mir bitte noch einmal behilflich:
Ich hatte die komplette Zeile "Call KommentarAenderung(Wert:=ComboBox1.Value, Zelle:=Me.Range("AD2")) wie von Dir beschrieben vor der Zeile "GoTo Beenden" eingefügt.
Vielleicht könntest Du mir bitte noch einmal zeigen, wie der Code genau aussehen müsste.
Mit ganzer Spalte AD als Adresse für den Kommentar meine ich, dass die ganze Prozedur für die Zellen AD2, AD3, AD4 etc. zur Anwendung kommen soll.
Vielen Dank vorab.
Jesko