VBA 边框 Excel 取决于页面大小

Question

我想根据页面的大小在每个 Excel 页面周围创建边框，例如行数和列数可以一直变化。我已经尝试过了，但它是特定的细胞

 Sub AddBorders()

 With Range("B8:I10")
     .Borders(xlEdgeLeft).LineStyle = xlContinuous
     .Borders(xlEdgeRight).LineStyle = xlContinuous
     .Borders(xlEdgeBottom).LineStyle = xlContinuous
     .Borders(xlEdgeTop).LineStyle = xlContinuous End With End Sub

Answer 1

UsedRange 不应该永远用于查找最后一个有数据的单元格。这是非常不可靠的。 。您可能想查看THIS有关usedrange的解释。

始终找到最后一行和最后一列，然后创建范围。请参阅此示例。

我推荐这种方式

Sub AddBorders()
    Dim ws As Worksheet
    Dim lastrow As Long, lastcol As Long

    Set ws = Sheet1 '<~~ Change as applicable

    With ws
        '~~> Check if sheet has any data
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            '~~> Get Last Row
            lastrow = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row

            '~~> Get Last Column
            lastcol = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByColumns, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Column

            '~~> Work with the range
            .Range(.Cells(1, 1), .Cells(lastrow, lastcol)).BorderAround _
            xlContinuous, xlMedium

        End If
    End With
End Sub

评论跟进

This works better. Only issue is border doesn't go around any graphs/charts. Is there a way to do that aswell? Thanks for your help – user1296762 7 mins ago

Also sorry can we have the bottom border last row+1 as some rows are grouped up and therefore line can't be seen if not expanded – user1296762 5 mins ago

这就是你正在尝试的吗？

Sub AddBorders()
    Dim ws As Worksheet
    Dim lastrow As Long, lastcol As Long
    Dim shp As Shape

    Set ws = Sheet1 '<~~ Change as applicable

    With ws
        '~~> Check if sheet has any data
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            '~~> Get Last Row
            lastrow = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row

            '~~> Get Last Column
            lastcol = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByColumns, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Column


        End If

        '~~> Loop through shapes and find the last row and column
        For Each shp In .Shapes
            If shp.BottomRightCell.Row > lastrow Then lastrow = shp.BottomRightCell.Row
            If shp.BottomRightCell.Column > lastcol Then lastcol = shp.BottomRightCell.Column
        Next

        If lastrow <> 0 And lastcol <> 0 Then
            'Also sorry can we have the bottom border last row+1 as some rows are
            'grouped up and therefore line can't be seen if not expanded
            '–  user1296762 2 mins ago
            lastrow = lastrow + 1: lastcol = lastcol + 1

            '~~> Work with the range
            .Range(.Cells(1, 1), .Cells(lastrow, lastcol)).BorderAround _
            xlContinuous, xlMedium
        End If
    End With
End Sub

截图