Live-Forum - Die aktuellen Beiträge
Datum
Titel
16.10.2025 18:38:17
Zusammenfassung nach Personalnummer
16.10.2025 17:40:39
Rabattstafel
16.10.2025 17:25:38
bedingte Formatierung
16.10.2025 16:39:53
Ergebnisse nach rechts ausgeben
Keine passende Antwort im Forumarchiv gefunden?
Stelle deine Frage im Live-Forum
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1540to1544
1540to1544
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Makro Einrahmen anpassen

Forumthread: Makro Einrahmen anpassen

Makro Einrahmen anpassen
19.02.2017 15:02:33
Leon
Hallo, ich habe mit dem Makrorecorder folgende Prozedur aufgezeichnet.
In der Mappe soll bei ausführen des Makros1 -Einrahmen- der Bereich A-L nach diesem Muster gerahmt werden:
Nun hätte ich aber gern, das bis zur letzten ausgefüllten Zeile im Bereich A-L egal in welcher Zelle dort ein Wert vorhanden ist- gerahmt wird.
Also Zellen A; B; C-E ; F; G; H und L sollen immer einen Außenrahmen erhalten- bis zur letzten ausgefüllten Zeile.
  • Sub Makro1()
' Makro1 Makro
' Rahme ein
Range("A1:B1").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("F1:L1").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("C1:E1").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A1:L1").Select
Selection.Copy
Range("A2:L8").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub


    • Wie kann der Code dafür aussehen?
    Gruß Leon
    Anzeige

    5
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: Makro Einrahmen anpassen
    19.02.2017 15:23:49
    Hajo_Zi
    Hallo Leon,
    nur wenige sehen Deine Datei, darum aufwendiger. 
    Option Explicit
Sub Makro1()
Dim LoLetzte As Long
Dim LoLetzte2 As Long
Dim InI As Integer
LoLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows. _
Count)
For InI = 2 To 12
LoLetzte2 = IIf(IsEmpty(Cells(Rows.Count, InI)), Cells(Rows.Count, InI).End(xlUp).Row,  _
Rows.Count)
If LoLetzte2 > LoLetzte Then LoLetzte = LoLetzte2
Next InI
With Range("A1:L" & LoLetzte)
'   Oben
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
'   ganz links
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
'   unten
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
'   ganz rechts
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
End With
End Sub

    Anzeige
    falls Komplett?
    19.02.2017 15:35:12
    Hajo_Zi
    Hallo Leon,
    Option Explicit
Sub Makro1()
Dim LoLetzte As Long
Dim LoLetzte2 As Long
Dim InI As Integer
LoLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows. _
Count)
For InI = 2 To 12
LoLetzte2 = IIf(IsEmpty(Cells(Rows.Count, InI)), Cells(Rows.Count, InI).End(xlUp).Row,  _
Rows.Count)
If LoLetzte2 > LoLetzte Then LoLetzte = LoLetzte2
Next InI
With Range("A1:L" & LoLetzte)
'   Oben
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
'   ganz links
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
'   unten
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
'   ganz rechts
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
'   zwischen den Spalten
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
'   zwischen den Zeilen
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
End With
End Sub
    Gruß Hajo
    Anzeige
    AW: Fast gut
    19.02.2017 15:51:20
    Leon
    Danke, Hajo.
    Super- Makro läuft nur noch eine kleine Abänderung?
    Der Zellbereich C-E soll einen Rahmen erhalten. Also dort "nicht alle Rahmenlinien.
    Alles andere läuft klappt.
    Die Zellen sind N I C H T verbunden. Ich weiß das VBA und Verbundenen Zellen sich nicht vertragen.
    Danke erst mal.
    Grüße Leon
    Anzeige
    AW: Fast gut
    19.02.2017 16:01:34
    Hajo_Zi
    Hallo Leon,
    Option Explicit
Sub Makro1()
Dim Loletzte As Long
Dim LoLetzte2 As Long
Dim InI As Integer
Loletzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows. _
Count)
For InI = 2 To 12
LoLetzte2 = IIf(IsEmpty(Cells(Rows.Count, InI)), Cells(Rows.Count, InI).End(xlUp).Row,  _
Rows.Count)
If LoLetzte2 > Loletzte Then Loletzte = LoLetzte2
Next InI
With Range("A1:L" & Loletzte)
'   Oben
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
'   ganz links
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
'   unten
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
'   ganz rechts
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
'   zwischen den Spalten
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
'   zwischen den Zeilen
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
End With
With Range("C1:E" & Loletzte)
'   zwischen den Spalten
.Borders(xlInsideVertical).LineStyle = xlNone
'   zwischen den Zeilen
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
End Sub

    Gruß Hajo
    Anzeige
    AW: Gut
    19.02.2017 16:08:34
    Leon
    Danke Hajo- super Arbeit.
    Das ist gar nicht so einfach.
    Herzlichen Dank.
    Grüße Leon
    ;

    Beliebteste Forumthreads (12 Monate)

    Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
    Anzeige
    Anzeige
    Entdecke mehr
    Finde genau, was du suchst

    Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

    Suche nach den besten Antworten
    Unsere beliebtesten Threads

    Entdecke unsere meistgeklickten Beiträge in der Google Suche

    Top 100 Threads jetzt ansehen
    Anzeige