复制单元格背景色

Question

我正在使用 Excel 2013，我想在 VBA 中编写一个具有两个参数（Sourcecell 和 Destinationcell）的函数，并简单地将 Backgroundcolor 从 Sourcecell 复制到 Destinationcell。这是我的：

Function setRGB2(ByVal sCell As Range, ByVal dCell As Range)
Dim lngColor As Long
Dim B As Long
Dim G As Long
Dim R As Long

On Error GoTo Fehler

lngColor = sCell.Interior.Color
B = lngColor / 65536
G = (lngColor - B * 65536) / 256
R = lngColor - B * 65536 - G * 256

Range(dCell).Interior.Color = RGB(R, G, B)
'Range(dCell).DisplayFormat.Interior.Color = RGB(R, G, B)

Fehler:
    With Err

    End With
End Function

我收到错误：

improper use of a property

例如，我的 Sourcecell 是 B16，我的 Destinationcell 是 B46。所以在 B46 中我写 =setRGB2($B;B46)。我尝试像 dCell.Interior.Color = sCell.Interior.Color 一样直接设置颜色，但那没有用。

编辑

我已经添加了参数声明。但这似乎是另一个问题。即使我这样做 dCell.Interior.ColorIndex = 1 它也会抛出同样的错误。

Answer 1

不确定你想用这个函数实现什么，但下面的代码应该是正确的，至少在语法上是正确的

Option Explicit

Function setRGB2(ByVal sCell As Range, ByVal dCell As Range)
    Dim lngColor As Long
    Dim B As Long
    Dim G As Long
    Dim R As Long

'    On Error GoTo Fehler

    lngColor = sCell.Interior.Color
    B = WorksheetFunction.Max(lngColor / 65536, 0)
    G = WorksheetFunction.Max((lngColor - B * 65536) / 256, 0)
    R = WorksheetFunction.Max(lngColor - B * 65536 - G * 256, 0)

    dCell.Interior.Color = RGB(R, G, B)
    'Range(dCell).DisplayFormat.Interior.Color = RGB(R, G, B)

    Exit Function

Fehler:
    With Err

    End With
End Function

Sub TestIt()
    setRGB2 Range("A1"), Range("A2")
End Sub

Answer 2

用户定义函数无法更改 worksheet/cells 的状态。换句话说，不能改变颜色。 (Source)

但是Subs可以做到，所以你可以设计一个Function，然后从Sub调用函数。

但在您的情况下，带参数的 Sub 应该可以，您可以随时在 VBA 代码中以简单的方式调用它。

Sub testing()

setRGB2 [A1], [A2]

End Sub

Private Sub setRGB2(ByRef sCell As Range, ByRef dCell As Range)

dCell.Interior.Color = sCell.Interior.Color
End Sub

此外，我在回答开始时说过，UDF 无法更改工作表的状态，但如果出于任何原因您确实需要它，则可以通过一种非常复杂和硬核的方式来实现。

UDF to change cells color

另外，在你的问题中你说：

例如，我的 Sourcecell 是 B16，我的 Destinationcell 是 B46。所以在 B46 我写 =setRGB2($B;B46)

这是错误的，因为您正在创建循环引用，这会导致您出错。

More about circular references

Answer 3

首先检查单元格 是否有 颜色，如果有则复制它：

Public Sub CopyColour(ByRef Source As Range, ByRef Destination As Range)
    If Source.Interior.ColorIndex = xlColorIndexNone Then
        Destination.Interior.ColorIndex = xlColorIndexNone
    Else
        Destination.Interior.Color = Source.Interior.Color
    End If
End Sub

不管理渐变或图案。

复制单元格背景色

Copy Cell Backgroundcolor

excel

vba

excel-2013