在 Excel VBA 中，我試圖僅復制一個單元格的邊框並將其粘貼到另一個單元格上（不更改值、數字格式等）

Question

這個想法是，如果我在具有所需邊框格式的單元格上按 ctrl+c，然后單擊我想要應用所需邊框的新單元格，然后我可以運行宏並且只應用單元格邊框。 澄清一下，在現在具有新邊框的單元格中，原始字體、數字格式、大小、顏色、對齊方式不會改變。

更新

示例代碼：

Cells(1, 1).Formula = ActiveCell.Formula
Cells(1, 1).Font.Color = ActiveCell.Font.Color

Cells(1, 1).Font.ColorIndex = ActiveCell.Font.ColorIndex
Cells(1, 1).Font.Bold = ActiveCell.Font.Bold
Cells(1, 1).Font.FontStyle = ActiveCell.Font.Name
Cells(1, 1).Font.Size = ActiveCell.Font.Size
Cells(1, 1).NumberFormat = ActiveCell.NumberFormat
Cells(1, 1).HorizontalAlignment = ActiveCell.HorizontalAlignment
Cells(1, 1).VerticalAlignment = ActiveCell.VerticalAlignment
Cells(1, 1).WrapText = ActiveCell.WrapText
ActiveSheet.Paste
ActiveCell.Formula = Cells(1, 1).Formula
ActiveCell.Font.Color = Cells(1, 1).Font.Color
ActiveCell.Font.ColorIndex = Cells(1, 1).Font.ColorIndex
ActiveCell.Font.Bold = Cells(1, 1).Font.Bold
ActiveCell.Font.Name = Cells(1, 1).Font.Name
ActiveCell.Font.Size = Cells(1, 1).Font.Size
ActiveCell.NumberFormat = Cells(1, 1).NumberFormat
ActiveCell.HorizontalAlignment = Cells(1, 1).HorizontalAlignment
ActiveCell.VerticalAlignment = Cells(1, 1).VerticalAlignment
ActiveCell.WrapText = Cells(1, 1).WrapText
Cells(1, 1).Clear

這有效，但會導致 ActiveSheet.paste 行出現調試錯誤。 但是如果我用調試再次運行它，它就會工作。

第二次更新

不幸的是，對於像我這樣的外行來說，您的解決方案似乎有點過於復雜。 我相信我已經解決了我在下面尋找的問題：

Sub Test()

Dim RowRef, ColRef, Alignment As Integer
Dim Color As Double
Dim NumForm, Formula As String

RowRef = ActiveCell.Row
ColRef = ActiveCell.Column

NumForm = Cells(RowRef, ColRef).NumberFormat
Formula = Cells(RowRef, ColRef).Formula
Color = Cells(RowRef, ColRef).Font.Color
Alignment = Cells(RowRef, ColRef).HorizontalAlignment

Cells(RowRef, ColRef).PasteSpecial (xlPasteAll)

Cells(RowRef, ColRef).NumberFormat = NumForm
Cells(RowRef, ColRef).Formula = Formula
Cells(RowRef, ColRef).Font.Color = Color
Cells(RowRef, ColRef).HorizontalAlignment = Alignment

End Sub

我可以簡單地添加更多我想要保持相同格式的特征，但解決方案的要點似乎如上所述。 如果您有時間確認或提供有關如何改進更多的任何方向，請告訴我。

Answer 1

這是一個答案......但也不是-因為它並不完全是工作，但也許有人可以填補空白。

必須有一種方法可以使用Borders對象來執行此操作，該對象是四個Border對象的集合。

我以為我可以通過XlBordersIndex枚舉或范圍的Borders屬性進行For Each XlBordersIndex ，例如：

For Each b in Range("A1:A4").Border

...然后設置屬性，例如XlBorderWeight和XlLineStyle 。

但是，我嘗試了一些可能的解決方案，但沒有任何表現符合預期。

例如：

Sub copyBorders()
    Dim rgFrom As Range:  Set rgFrom = ThisWorkbook.Sheets("Sheet1").Range("A1")
    Dim rgTo As Range:    Set rgTo = ThisWorkbook.Sheets("Sheet1").Range("C1")

    Dim bFrom As Borders: Set bFrom = rgFrom.Borders
    Dim bTo As Borders:   Set bTo = rgTo.Borders

    Dim arr, bs
    arr = Array(xlDiagonalDown, xlDiagonalUp, xlEdgeBottom, xlEdgeLeft, _
                xlEdgeRight, xlEdgeTop, xlInsideHorizontal, xlInsideVertical)

    For Each bs In arr  'same as using `For bs = 5 to 12`
        With bFrom(bs)
            bTo(bs).Color = .Color
            bTo(bs).ColorIndex = .ColorIndex
            bTo(bs).LineStyle = .LineStyle
            bTo(bs).TintAndShade = .TintAndShade
            bTo(bs).Weight = .Weight
        End With
    Next bs
End Sub

...以及我嘗試將C1的邊框與A1匹配的奇怪結果：

我自己可能永遠不會有理由使用它，但仍然很好奇如何使這種方法起作用，並且對我為什么得到我所做的結果感到困惑。

---

我首先想到/希望它會像以下一樣簡單：

Range1.Borders = Range2.Borders

...或至少是這樣的：

Range1.Borders(xlEdgeRight) = Range2.Borders(xlEdgeRight)

......但沒有這樣的運氣。

Answer 2

一個有趣的挑戰。 它是@user1274820 描述的變體：

Excel VBA - 當活動/選定單元格不同時獲取復制的單元格地址

在ThisWorkbook 中放入以下代碼：

Option Explicit

Private Sub Workbook_Open()
    Application.OnKey "^c", "CopyEvent"
End Sub

在一個模塊中，放置以下代碼：

Option Explicit

Dim CopyCells As Range

Private Sub CopyEvent()
    Set CopyCells = Selection
    Selection.Copy
End Sub

Public Sub PasteBorders()
    If Not CopyCells Is Nothing Then
        ActiveCell.Borders().LineStyle = CopyCells.Borders().LineStyle
        ActiveCell.Borders().Color = CopyCells.Borders().Color
    End If
End Sub

保存/關閉工作簿並重新打開它以首次運行 Workbook_Open。

訣竅是復制的范圍通常無法訪問，因此在按下 Ctrl-C 時會顯式保存它。 當 PasteBorders 代碼運行時，它只從選定范圍復制線型和顏色。