Excel 2003 VBA
27.12.2007 12:10:00
Flinx
Ich habe da ein Problem, bei dessen Lösung ihr mir vielleicht auf die Sprünge helfen könntet.
Absicht:
Zeile bis zur aktiven Zelle markieren
bei Auswahl der nächsten Zelle Markierung zurücksetzen und neuen Bereich markieren
..und das in allen Tabellen einer Arbeitsmappe und in allen Arbeitsmappen
Lösung:
über Klassenmodul (Beispiele dafür gab es genug),
funktioniert auch innerhalb einer Tabelle, nach dem Wechsel in eine andere Tabelle/Arbeitsmappe auch,
jedoch wird die letzte Markierung in der Vorgängertabelle nicht aufgehoben. Es erscheint auch eine Fehlermeldung, die ich mit meinen Kenntnissen aber nicht in eine Lösung umsetzen kann.
Ich habe mal versucht, das Ganze so verständlich wie mir möglich, auszukommentieren, hoffe, ich bringe da nicht zu viel durcheinander
Modul1
Option Explicit
Dim oKlasseExcel As clsExcelApp
Private Sub ExcelWatch_Initialize()
Set oKlasseExcel = New clsExcelApp
Set oKlasseExcel.ExcelWatch = Application
End Sub
Private Sub ExcelWatch_Terminate()
Set oKlasseExcel = Nothing
End Sub
Klassenmodul
Option Explicit
Public WithEvents ExcelWatch As Application
Public intc As Integer 'Wert für Vorgängerzelle Zeile
Public intr As Integer 'Wert für Vorgängerzelle Spalte
Private Sub ExcelWatch_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'Die Prozedur markiert die Zeile bis zur aktiven Zelle, setzt die Markierung bei Wechsel
'zu einer anderen Zelle innerhalb des Blattes wieder zurück und markiert den neuen Bereich
Dim newc As Integer 'Spalte der aktiven Zelle
Dim newr As Integer 'Zeile der aktiven Zelle
Dim myrangeold As Range 'Range der Vorgängerzelle
Dim myRangeNew As Range 'Range der aktiven Zelle
'? die Namen des aktuellen Tabellenblattes sowie der Arbeitsmappe vorhalten,
'da diese eventuell beim Wechsel auf ein anderes Tabellenblatt / Arbeitsmappe benötigt werden ?
Dim mysheet As String
Dim myWorkbook As String
'Hier werden die Werte der alten Zelle vorgehalten
If intc 0 And intr 0 Then
For intc = 1 To intc
Set myrangeold = Sh.Range(Cells(intr, 1), Cells(intr, intc))
myrangeold.Borders(xlEdgeBottom).LineStyle = xlNone
Next
End If
'Die aktive Zeile erhält einen Unterstrich bis zur aktiven Zelle
newc = ActiveCell.Column
newr = ActiveCell.Row
For newc = 1 To newc
Set myRangeNew = Sh.Range(Cells(newr, newc), ActiveCell)
myRangeNew.Borders(xlEdgeBottom).LineStyle = xlDash
myRangeNew.Borders(xlEdgeBottom).Weight = xlThin
myRangeNew.Borders(xlEdgeBottom).ColorIndex = 3
Next
'MsgBox ("neue Adresse: " & newc & "," & newr)
'Der Wert der aktiven Zelle wird den intc und intr Variablen als "alte" Zelle zugewiesen
intc = ActiveCell.Column
intr = ActiveCell.Row
mysheet = ActiveSheet.Name
myWorkbook = ActiveWorkbook.Name
'MsgBox ("Zelle " & intc & "," & intr & " in Sheet " & mysheet & " in WB " & myWorkbook)
End Sub
Private Sub ExcelWatch_SheetActivate(ByVal Sh As Object)
'Bei Wechsel des Sheets wird die Markierung im Vorgängerblatt aufgehoben
' hm..oder sollte sie zumindest :-)
Dim myWorkbook As String
Dim mysheet As String
Dim myrangeold As Range
If intc 0 And intr 0 Then
For intc = 1 To intc
Set myrangeold = Sh(mysheet).Range(Cells(intr, 1), Cells(intr, intc))
myrangeold.Borders(xlEdgeBottom).LineStyle = xlNone
Next
End If
End Sub