Markierung durch VBA Code nach Speichern löschen?

Forumthread: Markierung durch VBA Code nach Speichern löschen?

09.06.2017 23:01:39

Stefanie

Hallo zusammen,
ich habe online folgenden VBA Code gefunden, mit dem man eine Änderung in Excel farblich markieren kann:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not (Intersect(Target, Range("a:xfd")) Is Nothing) Then
Target.Interior.ColorIndex = 3
End If
End Sub

Gibt es die Möglichkeit, dass die farbliche Markierung nach dem Speichern entfernt und nur die Textänderung beibehalten wird?
Viele Grüße,
Stefanie

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Markierung durch VBA Code nach Speichern löschen?

09.06.2017 23:13:53

Sepp

Hallo Stefanie,
nach dem Speichern nicht, aber davor.

' **********************************************************************
' Modul: DieseArbeitsmappe  Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Sheets("Tabelle1").Range("a:xfd").Interior.ColorIndex = xlNone
End Sub

Oder du löschst die Farben beim Workbook_Open-Ereignis.

Gruß Sepp

AW: Markierung durch VBA Code nach Speichern löschen?

10.06.2017 06:03:05

Stefanie

Hallo Sepp,
danke erstmal für deine Hilfe. Ich habe deinen Code nach "meinem" eingefügt.
Es wird dann nicht mehr markiert, aber die Markierung zuvor sind immer noch da.
Habe ich was falsch gemacht :(
Viele Grüße
Stefanie

AW: Markierung durch VBA Code nach Speichern löschen?

10.06.2017 06:45:26

Sepp

Hallo Stefanie,
mein Code gehört in das Modul "DieseArbeitsmappe". Er löscht alle Hintergundfarben im Bereich A:XFD, was sonnst noch in deiner Datei passiert, kann ich nicht wissen.

Gruß Sepp

AW: Markierung durch VBA Code nach Speichern löschen?

10.06.2017 11:05:28

Stefanie

Hallo Sepp,
jetzt hat es geklappt. Vielen Dank.
Gibt es auch eine Möglichkeit nur die Füllfarben zu löschen, die durch eine Änderung markiert wurden?
Ich habe in der Datei einige Zellen manuell markiert und die sollten immer fest farblich markiert bleiben.
Viele Grüße
Stefanie

AW: Markierung durch VBA Code nach Speichern löschen?

10.06.2017 11:52:40

Sepp

Hallo Stafanie,
ja gibt es, komme aber heute nicht mehr dazu.

Gruß Sepp

AW: Markierung durch VBA Code nach Speichern löschen?

10.06.2017 12:05:46

Stefanie

Oki, trotzdem ganz vielen Dank für deine Hilfe :)

AW: Markierung durch VBA Code nach Speichern löschen?

10.06.2017 13:25:31

Sepp

Hallo Stefanie,
habs doch noch geschafft ;-))
Achte darauf, welcher Code in welches Modul gehört!

' **********************************************************************
' Modul: DieseArbeitsmappe  Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim lngIndex As Long, objSht As Worksheet

If (0 / 1) + (Not Not pvarChange) <> 0 Then
  For lngIndex = 0 To UBound(pvarChange)
    Set objSht = getSheetByCodename(Split(pvarChange(lngIndex), "|")(0))
    With objSht.Range(Split(pvarChange(lngIndex), "|")(1)).Interior
      If Clng(Split(pvarChange(lngIndex), "|")(2)) < 16777215 Then
        .Color = Clng(Split(pvarChange(lngIndex), "|")(2))
      Else
        .Color = xlNone
      End If
    End With
    Set objSht = Nothing
  Next
End If

End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rng As Range
Select Case Sh.Name
  Case "Tabelle1", "Tablle3"  'Tabellen auf denen geprüft wird
    If Not Intersect(Target, Range("A:XFD")) Is Nothing Then
      For Each rng In Target
        If (0 / 1) + (Not Not pvarChange) = 0 Then
          Redim pvarChange(0)
        Else
          Redim Preserve pvarChange(UBound(pvarChange) + 1)
        End If
        
        pvarChange(UBound(pvarChange)) = Sh.CodeName & "|" & rng.Address(0, 0) & "|" & rng.Interior.Color
        rng.Interior.ColorIndex = 3
      Next
    End If
  Case Else
End Select
End Sub

' **********************************************************************
' Modul: basMain  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public pvarChange() As Variant

Public Function getSheetByCodename(ByVal strvCodeName As String, Optional ByRef wkbrWorkBook As Workbook) As Object
Dim objSheet As Object
On Error GoTo ERRORHANDLER
If wkbrWorkBook Is Nothing Then Set wkbrWorkBook = ThisWorkbook
For Each objSheet In wkbrWorkBook.Sheets
  If objSheet.CodeName = strvCodeName Then
    Set getSheetByCodename = objSheet
    Set objSheet = Nothing
    Exit Function
  End If
Next
ERRORHANDLER:
Set getSheetByCodename = Nothing
End Function

Gruß Sepp

AW: Markierung durch VBA Code nach Speichern löschen?

10.06.2017 21:38:30

Stefanie

Omg, ich hätte nicht gedacht, dass das so viel sein wird.
Danke, Danke, Daaaaaaaaaaaanke.
Für deine Hilfe, deine Mühe, bist der Beste :3

Verbesserte Version

11.06.2017 11:29:03

Sepp

Hallo Stefanie,
hier eine bessere und universellere Version.

' **********************************************************************
' Modul: DieseArbeitsmappe  Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Sub Workbook_BeforeClose(Cancel As Boolean)
Dim lngIndex As Long, objSht As Worksheet

If colChanges.Count > 0 Then
  For lngIndex = 1 To colChanges.Count
    Set objSht = getSheetByCodename(colChanges(lngIndex).SheetCodeName)
    If Not objSht Is Nothing Then
      With objSht.Range(colChanges(lngIndex).CellAddress)
        .Interior.Color = colChanges(lngIndex).CellInteriorColor
        .Font.Color = colChanges(lngIndex).CellFontColor
      End With
      Set objSht = Nothing
    End If
  Next
  Set colChanges = Nothing
End If

End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rng As Range, clsItem As clsCollection

Select Case Sh.Name
  Case "Tabelle1", "Tabelle2" 'Tabellen auf denen geprüft wird
    'Zellbereich einschränken
    If Not Intersect(Target, Range("A:XFD")) Is Nothing Then
      For Each rng In Target
        If Not KeyExists(colChanges, rng.Parent.CodeName & rng.Address(0, 0)) Then
          Set clsItem = New clsCollection
          With clsItem
            .SheetCodeName = rng.Parent.CodeName
            .CellAddress = rng.Address(0, 0)
            .CellInteriorColor = rng.Interior.Color
            .CellFontColor = rng.Font.Color
          End With
          colChanges.Add clsItem, rng.Parent.CodeName & rng.Address(0, 0)
          Set clsItem = Nothing
        End If
        'geänderte Zellen kennzeichnen
        rng.Interior.Color = vbRed
        rng.Font.Color = vbYellow
      Next
    End If
  Case Else
End Select
End Sub

' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public colChanges As New Collection

Public Function KeyExists(coll As Collection, Key As String) As Boolean
On Error GoTo ErrExit
coll.Item Key
KeyExists = True
ErrExit:
End Function

Public Function getSheetByCodename(ByVal strvCodeName As String, Optional ByRef wkbrWorkBook As Workbook) As Object
Dim objSheet As Object
On Error GoTo ERRORHANDLER
If wkbrWorkBook Is Nothing Then Set wkbrWorkBook = ThisWorkbook
For Each objSheet In wkbrWorkBook.Sheets
  If objSheet.CodeName = strvCodeName Then
    Set getSheetByCodename = objSheet
    Set objSheet = Nothing
    Exit Function
  End If
Next
ERRORHANDLER:
Set getSheetByCodename = Nothing
End Function

' **********************************************************************
' Modul: clsCollection  Typ: Klassenmodul
' **********************************************************************

Option Explicit

Private pstrCodename As String
Private pstrAddress As String
Private plngInteriorColor As Long
Private plngFontColor As Long


Public Property Get SheetCodeName() As String
SheetCodeName = pstrCodename
End Property

Public Property Let SheetCodeName(value As String)
pstrCodename = value
End Property

Public Property Get CellAddress() As String
CellAddress = pstrAddress
End Property

Public Property Let CellAddress(value As String)
pstrAddress = value
End Property

Public Property Get CellInteriorColor() As Long
If plngInteriorColor < 16777215 Then
  CellInteriorColor = plngInteriorColor
Else
  CellInteriorColor = -4142
End If
End Property

Public Property Let CellInteriorColor(value As Long)
plngInteriorColor = value
End Property

Public Property Get CellFontColor() As Long
CellFontColor = plngFontColor
End Property

Public Property Let CellFontColor(value As Long)
plngFontColor = value
End Property

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Markierung durch VBA Code nach Speichern löschen?

Forumthread: Markierung durch VBA Code nach Speichern löschen?

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Markierung durch VBA Code nach Speichern löschen?

Forumthread: Markierung durch VBA Code nach Speichern löschen?

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread