Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
18.04.2024 18:04:29
Formel fehler Wert#
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
648to652
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
648to652
648to652
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Rahmen automatisch

Rahmen automatisch
09.08.2005 14:22:13
Tom
Hallo,
wie kann ich erreichen, dass das Format (dicker Rahmen unten) nach jedem neuen Bereich (Spalte B) automatisch, mittels eines Makros, erstellt werden? Siehe Bsp-Mappe (IST und SOLL) https://www.herber.de/bbs/user/25457.xls
Dies ist nur ein Teil einer aus ca. 3600 Zeilen bestehenden Datei, die ständig erweitert wird. Somit ist der Aufwand alles manuell anzupassen eine Lebensaufgabe ...
Gruß und danke vorab
Tom

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Rahmen automatisch
09.08.2005 14:55:20
u_
Hallo,
in den Code der Tabelle:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
On Error GoTo errHandler
Application.EnableEvents = False
Rahmen
End If
errHandler:
Application.EnableEvents = True
End Sub

In ein Modul:
Sub Rahmen()
Dim C As Range
For Each C In Range(Cells(7, 2), Cells(7, 2).End(xlDown))
With Range(C.Offset(0, -1), C.Offset(0, 4))
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
If C C.Offset(-1, 0) Then
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Else
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
Next C
Set C = Cells(65536, 2).End(xlUp)
With Range(C.Offset(0, -1), C.Offset(0, 4))
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End With
End Sub
Gruß
Geist ist geil!
Anzeige
AW: Rahmen automatisch
09.08.2005 15:36:14
Tom
Hi u_
klappt wuenderbar - wie muß ich den Code anpassen, damit er auch bei einem gestezten Filter (Bsp Spalte C) funktioniert und dann die Rubriken trennt?
Vielleicht kannst Du mir nochmal helfen
Gruß
Tom
AW: Rahmen automatisch
09.08.2005 16:13:53
u_
Hallo,
ich verstehe nicht.
Gruß
Geist ist geil!
AW: Rahmen automatisch
09.08.2005 16:23:53
u_
Hallo,
so?

Private Sub Worksheet_Calculate()
On Error GoTo errHandler
Application.EnableEvents = False
Rahmen
errHandler:
Application.EnableEvents = True
End Sub

Am Anfang von Sub Kopieren noch Application.SreenUpdating=False setzen. Am Ende wieder auf True.
Gruß
Geist ist geil!
Anzeige
AW: Rahmen automatisch
09.08.2005 17:18:57
Tom
Hi,
ja fast ... Jetzt hängt es nur noch an einer Kleinigkeit:
Alles funktioniert wunderbar - Rahmenbildung mit und ohne Filter.
Nur wenn in Spalte C nach SK gefiltert wird, wird der Rahmen nicht richtig gesetzt. Aber nur bei dieser Filterung ... Wo liegt der Fehler ?
https://www.herber.de/bbs/user/25463.xls
Tom
AW: Rahmen automatisch
10.08.2005 09:38:16
u_
Hallo,

Sub Rahmen()
Dim C As Range, Ctmp As Range
For Each C In Range(Cells(6, 2), Cells(6, 2).End(xlDown)).SpecialCells(xlCellTypeVisible)
With Range(C.Offset(0, -1), C.Offset(0, 4))
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
If Not Ctmp Is Nothing Then
If C <> Ctmp Then
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Else
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
End If
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
Set Ctmp = C
Next C
Set C = Cells(65536, 2).End(xlUp)
With Range(C.Offset(0, -1), C.Offset(0, 4))
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End With
End Sub

Klappt aber nur mit Klick auf den Button. Anscheinend wird durch das Filtern kein Ereignis ausgelöst. Die Ereignisprozedur (Calculate) kannst du also löschen.
Gruß
Geist ist geil!
Anzeige
AW: Rahmen automatisch
10.08.2005 09:47:45
Tom
Sensationell - vielen Dank !!!!

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige