Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1424to1428
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
Inhaltsverzeichnis

Zellen einfügen mit Rahmenlinie per Makro

Zellen einfügen mit Rahmenlinie per Makro
05.05.2015 08:39:13
corsin
Guten Tag zusammen
Ich habe ein Excel-File mit einer Auflistung diverser Projekte, welche in weiteren Zellen noch zusätzliche Angaben haben wie Bereich, Kosten, Projektdauer etc.
Mittlerweile sind es in etwa 400 Projekte. Mein Vorgänger hat ein Makro geschrieben, mit welchem die ausgewählten Projekte in eine anschaubare Form gebracht werden.
Das Makro funktioniert soweit auch. Sobald ich aber mehr als 150 Projekte markiere schmiert Excel leider ab. Ich habe herausgefunden, dass das Problem darin besteht, dass das Makro für die Darstellung leere Zeilen einfügt und eine Rahmenlinie dazwischen setzt.
Hier mal das entsprechende Sub

Sub Zeilen_einfügen()
Sheets("Referenzliste").Select
Range("B5").Select
Do While ActiveCell  Empty
If ActiveCell  Empty Then
Do While ActiveCell  Empty
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
Selection.RowHeight = 4
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
Selection.RowHeight = 4
ActiveCell.Offset(0, 5).Select
'Stoppmarke für ToRightRange setzen
ActiveCell = "E"
ActiveCell.Offset(0, -5).Select
'Haarlinie einfügen
Range(Selection, Selection.End(xlToRight)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ActiveCell.Select
'Zellverbindungen einfügen
Do While ActiveCell  "E"
Range(Selection, Selection.End(xlUp)).Select
Selection.Merge
ActiveCell.Offset(0, 1).Select
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, -5).Select
ActiveCell.Offset(3, 0).Select
Loop
End If
ActiveCell.Offset(5, 0).Select
Loop

Ich weiss nicht genau wieso das selection.merge auch drin ist, aber das verursacht möglicherweise den Absturz.
für jegliche Hilfe bin ich sehr dankbar
Beste Grüsse
Corsin

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zellen einfügen mit Rahmenlinie per Makro
05.05.2015 15:49:41
fcs
Hallo Corsin,
der Kollege hat scheinbar irgendwie versucht, zwischen den Linien und dem Text einen Abstand zu erzeugen, um die Lesbarkeit zu verbessern.
Warum da Makro an 150 Zeilen mit zu verbindenden Zellen scheitert - ich weiss es nicht.
Ich würde an deiner Stelle die Formatierungen anders lösen.
z.B. Text in den Zellen vertikal zentrieren und Zeilenhöhe der einzelnen Zeilen vergrößern.
Auf die verbundenen Zellen würde ich ganz verzichten.
Gruß
Franz
Sub Zeilen_Formatieren()
Dim wks As Worksheet
Dim Zeile_1 As Long, Zeile_L As Long, Zeile As Long
Dim Spalte_1 As Long, Spalte_L As Long
Dim rngFormat As Range
Set wks = Sheets("Referenzliste")
Zeile_1 = 5 '1. zu formatierende Zeile
Spalte_1 = 2 'Spalte B - 1. zu formatierende Spalte
Spalte_L = 7 'Spalte G - Letzte zu formatierende Spalte
With wks
.Activate
Application.ScreenUpdating = False
'letzte Datenzeile in 1. Spalte ermitteln
Zeile_L = .Cells(.Rows.Count, Spalte_1).End(xlUp).Row
'zu formatiernder Zellbereich
Set rngFormat = .Range(.Cells(Zeile_1, Spalte_1), .Cells(Zeile_L, Spalte_L))
With rngFormat
'Alle Linienformate zurücksetzen
.Borders.LineStyle = xlLineStyleNone
'horizontale Haarlinien oben/unten/zwischen den Zellen
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
'Zeilenhöhe automatisch
.EntireRow.AutoFit
'Vertikale Ausrichtung zentrieren
.VerticalAlignment = xlCenter
End With
'in allen Zeilen die Zeilenhöhe um 6 erhöhen
For Zeile = Zeile_1 To Zeile_L
With .Rows(Zeile)
.RowHeight = .RowHeight + 6
End With
Next
End With
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Zellen einfügen mit Rahmenlinie per Makro
06.05.2015 08:55:33
corsin
Hallo Franz
Ich danke Dir vielmals für deine Hilfe.
Wenn ich dein Makro verwende hat es den Vorteil, dass die allgemeine Formatierung besser aussieht! Danke dafür :-)
Leider wird aber nun eine Haarlinie bei jeder Zelle erstellt. Da aber parallel über ein anderes Makro noch Überschriften und Spaltenbeschriftungen pro Bereich erstellt werden, sind nun diverse Haarlinien an Orten wo sie nichts zu suchen haben :-)
Ich habe mal ein Bild beigelegt wo du den Unterschied siehts.
Userbild
Besten Dank
Gruss
Corsin

Anzeige
AW: Zellen einfügen mit Rahmenlinie per Makro
06.05.2015 09:51:20
fcs
Hallo Corsin,
ich hab das Makro jetzt etwas angepaßt.
Es werden jetzt die Inhalte in Spalte B/C geprüft und abhängig davon Linienformate gesetzt.
Falls es noch nicht klappt, dann solltest du eine kleine Beispieldatei hier hochladen, statt eines Bildes. Dann kann man auch in Excel vernünftig am realen Objekt testen.
Gruß
Franz
Sub Zeilen_Formatieren()
Dim wks As Worksheet
Dim Zeile_1 As Long, Zeile_L As Long, Zeile As Long
Dim Spalte_1 As Long, Spalte_L As Long
Dim rngFormat As Range
Dim bolLinie As Boolean
Set wks = Sheets("Referenzliste")
Zeile_1 = 5 '1. zu formatierende Zeile
Spalte_1 = 2 'Spalte B - 1. zu formatierende Spalte
Spalte_L = 7 'Spalte G - Letzte zu formatierende Spalte
With wks
.Activate
Application.ScreenUpdating = False
'letzte Datenzeile in 1. Spalte ermitteln
Zeile_L = .Cells(.Rows.Count, Spalte_1).End(xlUp).Row
'zu formatiernder Zellbereich
Set rngFormat = .Range(.Cells(Zeile_1, Spalte_1), .Cells(Zeile_L, Spalte_L))
With rngFormat
'Alle Linienformate zurücksetzen
.Borders.LineStyle = xlLineStyleNone
'Zeilenhöhe automatisch
.EntireRow.AutoFit
'Vertikale Ausrichtung zentriert
.VerticalAlignment = xlCenter
End With
'in allen Zeilen die Zeilenhöhe um 6 erhöhen, Inhalte prüfen, ggf. Linie-Oben
For Zeile = Zeile_1 To Zeile_L
With .Rows(Zeile)
.RowHeight = .RowHeight + 6
End With
If .Cells(Zeile, Spalte_1) = "" And .Cells(Zeile, Spalte_1 + 1) = "" Then
'bei leerer Zeile Formatieren von Linie-Oben deaktivieren
bolLinie = False
ElseIf LCase(Left(.Cells(Zeile, Spalte_1).Text, 7)) = "objekt," Then
'bei Zeile mit "OBJEKT,....." Formatieren von Linie-Oben aktivieren
bolLinie = True
ElseIf .Cells(Zeile, Spalte_1)  "" And bolLinie = True Then
'Haarlinie oben wenn Zelle mit Inhalt und Formatieren Linie-Oben aktiv
Set rngFormat = .Range(.Cells(Zeile, Spalte_1), .Cells(Zeile, Spalte_L))
With rngFormat.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
End If
Next
End With
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Zellen einfügen mit Rahmenlinie per Makro
06.05.2015 10:37:40
corsin
Hallo Franz
Du bist ja flott mit antworten. Besten Dank!
Deine Prüfung die du eingebaut hast funktioniert.
Ausser beim 1. Bereich Projektmanagement klappt es nicht. Aber keine Ahnung wieso nicht. In diesem Bereich werden gar keine Linien gesetzt. Bei allen anderen schon.
Um die Datei hier hochzuladen müsste ich sie noch entschärfen. Hast du eine Erklärung warum es beim ersten Bereich nicht klappen könnte?
Falls nötig werde ich gerne die Datei bereitstellen.
Vielen Dank & Beste Grüsse
Corsin

AW: Zellen einfügen mit Rahmenlinie per Makro
06.05.2015 11:41:40
fcs
Hallo Corsin,
passe in der folgende Zeile die Zeilennummer 5 an:
    Zeile_1 = 5 '1. zu formatierende Zeile

Dies muss die 1. Zeile sein, in der in Spalte B der Eintrag "OBJEKT, BAUSUMME" steht.
Also wahrscheinlich 4.
Gruß
Franz

Anzeige
AW: Zellen einfügen mit Rahmenlinie per Makro
06.05.2015 12:11:19
corsin
Bingo! Perfekt! Funktioniert nun einwandfrei.
Vielen tausend Dank für die Erstellung des Makros!
Ich wünsch dir einen schönen Tag
Gruss
Corsin

319 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige