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

从评论中跟进

效果更好。唯一的问题是边界不会绕过任何图表/图表。还有办法做到这一点吗？感谢您的帮助 - user1296762 7分钟前

也很遗憾，我们可以将最后一行的下边框加上+1，因为有些行已经分组，因此如果不展开则无法看到行 - user1296762 5分钟前

这是你在尝试的吗？

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

<强> Sceenshot

Answer 2

您可以使用：

ActiveSheet.UsedRange.BorderAround xlContinuous, xlMedium

我相信这样做会。

VBA边框Excel取决于页面大小

2 个答案: