AW: Danke, aber noch eine Frage an Dich Hajo!
19.08.2003 20:27:30
Hajo_Zi
Hallo Oliver
hast Du Dir da nicht ein wenig viel vorgenommen, bei VBA Nein.
Ich habe es noch nicht gemacht für 256 Spalte (eine Zeile) bis Spalte M habe ich schon mal ein Code erarbeitet.
' **************************************************************
' Modul: DieseArbeitsmappe Typ = Element der Mappe(Sheet, Workbook, ...)
' **************************************************************
Option Explicit
' erstellt von Hajo.Ziplies@web.de 14.12.02; 29.04.03
' Zelle A bis M markieren falls die Aktive Zelle in diesem Bereich
' alte Farbe wieder zurückstellen bei wechsel und schliessen
' farbveränderungen im markiertem Bereich werden nicht zurück gestellt, außer Rot
Private Sub Workbook_Open()
If ActiveCell.Column < 14 Then Auslesen
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Zurück
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Zurück
' Nur Bestimmte Zeilen
If (ActiveCell.Row >= 7 And ActiveCell.Row <= 102) _
Or (ActiveCell.Row >= 109 And ActiveCell.Row <= 170) _
Or (ActiveCell.Row >= 180 And ActiveCell.Row <= 199) Then
If ActiveCell.Column < 14 Then Auslesen
End If
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Zurück
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Zurück
' Nur Bestimmte Zeilen
If (ActiveCell.Row >= 7 And ActiveCell.Row <= 102) _
Or (ActiveCell.Row >= 109 And ActiveCell.Row <= 170) _
Or (ActiveCell.Row >= 180 And ActiveCell.Row <= 199) Then
If ActiveCell.Column < 14 Then Auslesen
End If
End Sub
Sub Zurück()
If StWert(1, 1, 1) <> "" Then
' Worksheets(StWert(1, 3, 3)).Unprotect
For InI = 1 To 13
If Worksheets(StWert(InI, 3, 3)).Range(StWert(InI, 2, 2)).Interior.ColorIndex = 3 Then
Worksheets(StWert(InI, 3, 3)).Range(StWert(InI, 2, 2)).Interior.ColorIndex = CInt(StWert(InI, 1, 1))
End If
Next InI
' Worksheets(StWert(1, 3, 3)).Protect
End If
End Sub
Sub Auslesen()
' ActiveSheet.Unprotect
For InI = 1 To 13
' Werte auslesen
StWert(InI, 1, 1) = Cells(ActiveCell.Row, InI).Interior.ColorIndex
StWert(InI, 2, 2) = Cells(ActiveCell.Row, InI).Address
StWert(InI, 3, 3) = ActiveSheet.Name
Cells(ActiveCell.Row, InI).Interior.ColorIndex = 3
Next InI
' ActiveSheet.Protect
End Sub
' **************************************************************
' Modul: Modul1 Typ = Allgemeines Modul
' **************************************************************
Option Explicit
' erstellt von Hajo.Ziplies@web.de 14.12.02
Public StWert(13, 3, 3) As String ' 1=Farbe; 2=Zelle; 3= Register
Public InI As Integer
Code eingefügt mit: Excel Code Jeanie
Falls Code vorhanden wurde dieser getestet unter Betriebssystem XP Pro und Excel Version XP SBE.
Bitte kein Mail, Probleme sollen im Forum gelöst werden.
Microsoft MVP für Excel
Das Forum lebt auch von den Rückmeldungen.
Zurzeit gibt es wieder Probleme mit der E-Mail Benachrichtigung.
Ich bekomme Mails zu Beiträgen an denen ich nicht beteiligt bin und zusätzlich noch Mails zu meinen eigenen Beiträgen.
Das Problem mit den eigenen Benachrichtigung kann gelöst werden durch Lösche und Neuanmelden. Dieses möchte ich aber nicht jeden Tag machen.
Um dieses Problem erstmal zu beseitigen habe ich die automatische Mailbenachrichtigung abgeschaltet.
Aus diesem Grunde ist es dem Zufall überlassen ob auf Rückfragen Antworten von mir kommen.