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

我收到错误：

不正当使用财产

例如，我的Sourcecell是B16，而我的Destinationcell是B46。所以在B46中我写=setRGB2($B$16;B46)。我尝试直接设置颜色，如dCell.Interior.Color = sCell.Interior.Color，但那不起作用。

修改

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

Answer 1

用户定义的函数无法更改工作表/单元格的状态。换句话说，不能改变颜色。（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$16;B46)

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

More about circular references

Answer 2

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

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 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

不管理渐变或模式。

复制单元格Backgroundcolor

3 个答案: