✔ Excel - Rahmen um Zellen (automatisch bis zur letzten Reihe)

jerry0110

jerry0110

Erfahrenes Mitglied
Hi,

ich möchte folgendes Machen. Das Makro soll automatisch die letzte Reihe suchen und alle Zellen (in dem Fall A1:AC200) mit Rahmenlienien versehen. Ich habe hier versucht etwas zu basteln. Bevor ich die for Schleife genutzt habe, habe ich eine Range von A1:AC200 angegeben. Jedoch wenn ich nur Daten bis AC50 habe macht er natürlich die Rahmen bis 200. Das möchte ich nicht, da ich sonst beim Drucken zu viele Blätter generieren. Deshalb wollte ich das mit der for Schleife lösen. Mit "keinem" Erfolg :(

Code: 
Sub Rahmenlinien()

Dim source As Worksheet
Dim lastRow As Long
Dim rowNr As Long

Set source = Worksheets("Data")

lastRow = source.Range("A1").SpecialCells(xlLastCell).Row

source.Cells(lastRow).Borders(xlDiagonalDown).LineStyle = xlNone
source.Cells(lastRow).Borders(xlDiagonalUp).LineStyle = xlNone

For rowNr = 2 To lastRow

With source.Cells(lastRow).Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
End With

With source.Cells(lastRow).Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
End With

With source.Cells(lastRow).Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
End With

With source.Cells(lastRow).Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
End With

With source.Cells(lastRow).Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
End With

With source.Cells(lastRow).Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
End With

Next
  
End Sub
 
SpecialCells(xlLastCell) findet die letzte Zelle die initialisiert ist. Es kann aber sien, dass die Zellen davor keine Daten haben. Ich verwende darum jeweils die folgenden Funktionen
http://wiki.yaslaw.info/dokuwiki/doku.php/vba/excel/functions/getlastrowcol

Visual Basic: 
'/**
' * Ermittelt die letzte gefüllte Zeile eines Worksheets
' * @param  Worksheet   Das Worksheetobjekt, das durchsucht werden soll
' * @return Long        Die Zeilennummer. Wenn das ganze Sheet leer ist, ist der Rückgabewert 0
' */
Public Function xlsGetLastRow(ByRef sheet As Object) As Long
    Const xlCellTypeLastCell = 11

    'Zur letzten initialisierten Zeile gehen
    xlsGetLastRow = sheet.Cells.SpecialCells(xlCellTypeLastCell).row
   
    'Von dort zurücksuchen bis zur Letzten zeile mit Inhalt
    Do While sheet.application.WorksheetFunction.CountA(sheet.rows(xlsGetLastRow)) = 0 And xlsGetLastRow > 1
        xlsGetLastRow = xlsGetLastRow - 1
    Loop
End Function

'/**
' * Ermittelt die letzte gefüllte Zeile eines Worksheets
' * @param  Worksheet   Das Worksheetobjekt, das durchsucht werden soll
' * @return Long        Die Zeilennummer. Wenn das ganze Sheet leer ist, ist der Rückgabewert 0
' */
Public Function xlsGetLastColumn(ByRef sheet As Object) As Long
    Const xlCellTypeLastCell = 11

    'Zur letzten initialisierten Zeile gehen
    xlsGetLastColumn = sheet.Cells.SpecialCells(xlCellTypeLastCell).Column
   
    'Von dort zurücksuchen bis zur Letzten zeile mit Inhalt
    Do While sheet.application.WorksheetFunction.CountA(sheet.Columns(xlsGetLastColumn)) = 0 And xlsGetLastColumn > 1
        xlsGetLastColumn = xlsGetLastColumn - 1
    Loop
End Function
 
Wenn ich das jetzt abändere und die Funktion nehme dann kommt immer ein Objektfehler:

Code: 
Sub Rahmenlinien()
Dim source As Worksheet
Dim lastRow As Long
Dim rowNr As Long
Set source = Worksheets("Data")
xlsGetLastColumn = source.Range("A1").SpecialCells(xlCellTypeLastCell).Row
source.Cells(xlsGetLastColumn).Borders(xlDiagonalDown).LineStyle = xlNone
source.Cells(xlsGetLastColumn).Borders(xlDiagonalUp).LineStyle = xlNone
For xlsGetLastRow = 1 To -1
With source.Cells(xlsGetLastColumn).Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
End With

......

Zumindestens habe ich das vom Verständis so verstanden.
 
Fehlermeldung?
Fehlerzeile?

xlCellTypeLastCell hast du nicht definiert.
Meine Funktionen sind so geschrieben, dass sie aus anderen MS Produkten heraus verwendet werden können, ohne dass man die Excel Object Library einbinden muss.
xlCellTypeLastCell ist als 11 definiert.
Dein xlLastCell ist ebenfalls 11. Du kannst also getrost xlLastCell verwenden
 
Sei mir nicht böse aber ich versteh nur Bahnhof. Bin froh das ich ein wenig versteh was der Code so aussagt und ich habe auch viel schon so anpassen können. Aber jetzt verteh ich nur Bahnhof.

Die Fehlermelung ist: Fehler beim Koplilieren: Funktionsaufruf auf der Linken Seite der Zwuseisung muss den Typ Variante oder Objekt zurückgeben.
 
1) Auf welcher Zeile im Code?

2) Merke ich gerade, dass dein neuer Code dein Problem nicht löst. Du musst nicht meine Funktionen zerlegen und bei dir einbauen. Kopiere sie vollständig und wende sie an.
Visual Basic: 
lastRow= xlsGetLastRow(source)
 
Ok jetzt geht das Makro so durch. Nur leider macht er um keine einzige Zelle einen Rahmen.

Ich werde mal schauen warum... :)
 
Keine Ahnung wie dein Code jetzt aussieht. Aber du musst schon den Range von A1 bis zum neu berechneten letzten Feld nehmen.
 
Code: 
Sub Rahmenlinien()
Dim source As Worksheet
Dim lastRow As Long
Dim rowNr As Long

Set source = Worksheets("Data")
lastRow = xlsGetLastColumn(source)
For rowNr = 2 To lastRow
With source.Cells(lastRow).Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = 3
End With
With source.Cells(lastRow).Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = 3
End With
With source.Cells(lastRow).Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = 3
End With
With source.Cells(lastRow).Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = 3
End With
With source.Cells(lastRow).Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = 3
End With
With source.Cells(lastRow).Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = 3
End With
Next rowNr
End Sub


Ich geh davon aus, das er denkt, dass in AC1 die letzte Zeile ist, weil AC 2 leer ist.
Also müsste ich doch die letzte Zeile in Spalte A suchen für mein Verständnis.
 
Um antworten zu können musst du eingeloggt sein.

Neue Beiträge

Zurück