【原】Excel VBA 自定义函数/取得颜色值/GetColor/ChatGPT来帮忙

今天在修改控件颜色的时候，感觉很烦，记住的颜色代码不多，只得去翻对照表，光看一串数字，也不知道它是什么颜色，还得注释一下......

于是，就想写一个自定义函数，根据颜色的名称来取得相应的值，比如RGB什么的。说干就干，

其实也不想自己写，不是有ChatGPT嘛，让它给我写啊，于是经过一番你来我往，说真的，机器就是好，它不会生气，不嫌麻烦，不厌其烦：

终于，完成了一个自定义函数GetColor，效果是这个样子的：

代码如下，由于比较长，我只贴一部分，完整的代码在示例文件中：

在模块1里：

Function GetColor(colorName As String) As Long    Dim colorDict As Object    Set colorDict = CreateObject("Scripting.Dictionary")    colorDict("白") = rgb(255, 255, 255)    colorDict("白色") = rgb(255, 255, 255)    colorDict("White") = rgb(255, 255, 255)   .....此处略去100行    colorDict("青绿") = rgb(127, 255, 212)    colorDict("青绿色") = rgb(127, 255, 212)    colorDict("Aquamarine") = rgb(127, 255, 212)    '根据输入的颜色名称获取颜色值    Dim colorValue As Long    colorName = LCase(colorName)    For Each dictKey In colorDict.keys        If LCase(dictKey) = colorName Then            colorValue = colorDict(dictKey)            Exit For        End If    Next dictKey   GetColor = colorValueEnd Function

还有一个过程，跟这个函数的使用关系不大，把对照表转换成代码字符串用的：

Sub GenerateColorDictCode()     Sheet1.Activate    Dim colorDictCode As String    Dim i As Integer    For i = 1 To ActiveSheet.UsedRange.Rows.Count        If InStr(1, Range("A" & i).Value, "色") > 0 Then            colorDictCode = colorDictCode & "colorDict(""" & Replace(Range("A" & i).Value, "色", "") & """) = RGB(" & Range("C" & i).Value & ")" & vbCrLf        End If        colorDictCode = colorDictCode & "colorDict(""" & Range("A" & i).Value & """) = RGB(" & Range("C" & i).Value & ")" & vbCrLf        colorDictCode = colorDictCode & "colorDict(""" & Range("B" & i).Value & """) = RGB(" & Range("C" & i).Value & ")"        Range("D" & i).Value = colorDictCode        colorDictCode = ""    NextEnd Sub

简单解释一下代码：

其实这个自定义函数很简单，ChatGPT开始给出的代码是这样的：

Function GetColorByName(colorName As String) As Long    Select Case colorName        Case "Red"            GetColorByName = RGB(255, 0, 0)        Case "Green"            GetColorByName = RGB(0, 255, 0)        Case "Blue"            GetColorByName = RGB(0, 0, 255)        Case "Yellow"            GetColorByName = RGB(255, 255, 0)        Case Else            ' 默认为黑色            GetColorByName = RGB(0, 0, 0)    End SelectEnd Function

但这太少了，不能满足我的需求啊，于是我叫他给我列出多一点，然后还考虑到中英文颜色名称都能使用，后来它就改成使用字典的方式。它还考虑到使用中文名称时，不输入“色"也能查找颜色值。

跟它聊了许多，不知什么原因，也许是字符数量的限制，代码总是给不全，于是我就准备根据它提供的一个表自己来写。

但一看到那么多，想想也头大，于是想让它给我写一段代码，把对照表中的颜色名称（中、英文）和颜色值写成一句添加到字典的代码，它居然也写成功了！

唯一的问题是，在复制到VBA代码编辑器的时候，每行首尾多了一个双引号，颜色名称也多了一个双引号。

"colorDict(""白"") = RGB(255, 255, 255)colorDict(""白色"") = RGB(255, 255, 255)colorDict(""White"") = RGB(255, 255, 255)"

这难不倒我，复制到记事本里，观察一下，先把“”替换成#（随便什么字符，只要没有在这里面出现过就行），再把单边引号替换成空，再把#替换成单边引号“。

顺利完成，但还是有点小问题，它区分大小写，添加的英文颜色名称首字母是大写的，输入小写的还查不到。于是又跟它一通交涉，先是用这种方式

colorDict.CompareMode = TextCompare

好像没有用，于是又问它，给出的方案是：

把颜色值转换成小写，字典Key也转成小写后再比较，解决。但我觉得这样的效率要差一点。

以上就是我用ChatGPT协助写代码的一个过程，花的时间不比自己写的少，但感觉还是挺有意思的，并且它写的颜色代码值准确性应该比较高的。这里也顺便提一下， 这个函数的结果没有经过完全验证，如果要拿来用的话，请自行验证。

好了，今天就分享到这里，谢谢大家，我们下期再会。