В Excel VBA я пытаюсь скопировать только границу ячейки и вставить ее в другую ячейку (без изменения значения, формата чисел и т. Д.) - PullRequest
Новая
       48

В Excel VBA я пытаюсь скопировать только границу ячейки и вставить ее в другую ячейку (без изменения значения, формата чисел и т. Д.)

0 голосов
/ 08 октября 2018

Идея состоит в том, что если я нажму 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

Я могу просто добавить больше характеристик того, что я хочу, чтобы сохранить то же форматирование, но суть решения, кажется, заключается в следующем,Если у вас есть секунда, чтобы подтвердить или предоставить какое-либо указание о том, как улучшить работу, сообщите мне.

Ответы [ 2 ]

0 голосов
/ 09 октября 2018

Этот является ответом ... но также не является - поскольку он не вполне работает как есть, но, возможно, кто-то может заполнить пробелы.

Там должен быть способ сделать это, используя объект Borders, который представляет собой набор из четырех Borderобъекты.

Я думал, что смогу For Each -loop через перечисление XlBordersIndex или свойство Borders диапазона, например: 

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:

img

У меня, вероятно, никогда не будет причин использовать это сам, но, тем не менее, мне любопытно, какчтобы этот метод работал, и я не понял, почему я получил результат.

Сначала я подумал / надеялся, что это будет так же просто, как: 

Range1.Borders = Range2.Borders

..или, по крайней мере, что-то вроде: 

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

... но не такая удача.

0 голосов
/ 09 октября 2018

интересный вызов.Это изменение того, что @ 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, он только копирует стиль линии и цвет из выбранного диапазона.

...