Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1540to1544
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

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

    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
    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)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige