[VBA, Excel] 设置行合并表格的边框

 

 

'设置行合并表格的边框
'@Author: kmlxk#yahoo.com.cn
'@Date: 2012-05-10
'@Desc: Excel支持行合并功能，但是如何为整行设置边框，并且不显示行内部横边框呢
' 这段代码通过第一列来识别行，并横向选择整行，最后设置除内部横线外的边框
'
Sub 设置行合并表格的边框()
    Dim strStartCell As String
    Dim i As Long
    Dim iStart As Long
    Dim iEnd As Long
    Dim iRowStart As Long
    Dim iRowEnd As Long
    Dim iCols As Long
    Dim oSheet As Worksheet
    Dim oRange As Range
    Dim strEndCol As String
    Dim strRange As String
    
    ' 初始化变量
    
    ' 起始单元格
    strStartCell = "A"
    ' 起始行号
    iStart = 1
    
    Set oSheet = ActiveSheet
    ' 终止行号(取最大数据行)
    iEnd = oSheet.UsedRange.Rows.Count
    iCols = oSheet.UsedRange.Columns.Count
     
    ' 关闭屏幕更新
    Application.ScreenUpdating = False
    
    ' 最后一列的单元格字母
    ' TODO: 目前最多26列，完善以支持Z之后的表格
    strEndCol = Chr(64 + iCols)
    
    For i = iStart To iEnd
                
        ' 选择单元格
        Range(strStartCell & i).Select
        ' 选择行
        Range(Selection, Selection.End(xlToRight)).Select
        ' 如果选择不完整
        Set oRange = Application.Selection
        If oRange.Columns.Count < iCols Then
            ' 扩展选择区域
            iRowStart = oRange.Row
            iRowEnd = oRange.Rows.Item(oRange.Rows.Count).Row
            strRange = "A" & iRowStart & ":" & strEndCol & iRowEnd
            oSheet.Range(strRange).Select
        End If
        
        ' 为「选中表格行」设置「行合并风格」的边框
        setCombinedRowsBorderOnSelected
    
    Next
    
    '开启屏幕更新
    Application.ScreenUpdating = True

End Sub

' 为「选中表格行」设置「行合并风格」的边框
Sub setCombinedRowsBorderOnSelected()
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

 

 

效果如图所示