Excel：在剪切和粘贴过程中恢复（或不剪切）单元格边框

Question

在 Excel 工作表中，我想剪切单元格并将它们粘贴到同一工作表的另一个位置，但原始单元格中的边框在此过程中丢失。 我正在尝试使用工作表中的这些 VBA 子项恢复边框，但我的代码不会恢复粗边框并创建原始单元格中不存在的对角边框。

Private originalBorders As Collection

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' Check if the selection change is due to Cut operation
    If Application.CutCopyMode = xlCut Then
        ' Store original borders of the selected cells
        Set originalBorders = New Collection
        SaveBorders originalBorders, Target
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Check if originalBorders is set
    If Not originalBorders Is Nothing Then
        ' Reapply original borders to the destination cells after paste operation
        RestoreBorders originalBorders, Target
        ' Clear originalBorders
        Set originalBorders = Nothing
    End If
End Sub

Private Sub SaveBorders(ByRef bordersCollection As Collection, ByVal rng As Range)
    ' Save the border settings of the given range
    Dim border As Object
    For Each border In rng.Borders
        bordersCollection.Add border.LineStyle
        bordersCollection.Add border.Color
        bordersCollection.Add border.TintAndShade
        bordersCollection.Add border.Weight
    Next border
End Sub

Private Sub RestoreBorders(ByRef bordersCollection As Collection, ByVal rng As Range)
    ' Restore the border settings to the given range
    Dim borderIndex As Integer
    Dim border As Object
    For Each border In rng.Borders
        border.LineStyle = bordersCollection(borderIndex + 1)
        border.Color = bordersCollection(borderIndex + 2)
        border.TintAndShade = bordersCollection(borderIndex + 3)
        border.Weight = bordersCollection(borderIndex + 4)
        borderIndex = borderIndex + 4
    Next border
End Sub

Answer 1

• 请尝试一下。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' Check if the selection change is due to Cut operation
    If Not Application.CutCopyMode = xlCut Then ' **
        ' Store original borders of the selected cells
        Set originalBorders = New Collection
        SaveBorders originalBorders, Target
    End If
End Sub

Private Sub RestoreBorders(ByRef bordersCollection As Collection, ByVal rng As Range)
    ' Restore the oBorder settings to the given range
    Dim borderIndex As Integer
    Dim oBorder As border
    Debug.Print "restore " & rng.Address
    For Each oBorder In rng.Borders
        oBorder.LineStyle = bordersCollection(borderIndex + 1)
        If oBorder.LineStyle <> xlNone Then ' **
            oBorder.Color = bordersCollection(borderIndex + 2)
            oBorder.TintAndShade = bordersCollection(borderIndex + 3)
            oBorder.Weight = bordersCollection(borderIndex + 4)
        End If
        borderIndex = borderIndex + 4
    Next oBorder
End Sub