今天在修改控件颜色的时候,感觉很烦,记住的颜色代码不多,只得去翻对照表,光看一串数字,也不知道它是什么颜色,还得注释一下......
于是,就想写一个自定义函数,根据颜色的名称来取得相应的值,比如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 = colorValue
End 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 = ""
Next
End 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 Select
End Function
但这太少了,不能满足我的需求啊,于是我叫他给我列出多一点,然后还考虑到中英文颜色名称都能使用,后来它就改成使用字典的方式。它还考虑到使用中文名称时,不输入“色"也能查找颜色值。
跟它聊了许多,不知什么原因,也许是字符数量的限制,代码总是给不全,于是我就准备根据它提供的一个表自己来写。
但一看到那么多,想想也头大,于是想让它给我写一段代码,把对照表中的颜色名称(中、英文)和颜色值写成一句添加到字典的代码,它居然也写成功了!
唯一的问题是,在复制到VBA代码编辑器的时候,每行首尾多了一个双引号,颜色名称也多了一个双引号。
"colorDict(""白"") = RGB(255, 255, 255)
colorDict(""白色"") = RGB(255, 255, 255)
colorDict(""White"") = RGB(255, 255, 255)"
这难不倒我,复制到记事本里,观察一下,先把“”替换成#(随便什么字符,只要没有在这里面出现过就行),再把单边引号替换成空,再把#替换成单边引号“。
顺利完成,但还是有点小问题,它区分大小写,添加的英文颜色名称首字母是大写的,输入小写的还查不到。于是又跟它一通交涉,先是用这种方式
colorDict.CompareMode = TextCompare
好像没有用,于是又问它,给出的方案是:
把颜色值转换成小写,字典Key也转成小写后再比较,解决。但我觉得这样的效率要差一点。
以上就是我用ChatGPT协助写代码的一个过程,花的时间不比自己写的少,但感觉还是挺有意思的,并且它写的颜色代码值准确性应该比较高的。这里也顺便提一下, 这个函数的结果没有经过完全验证,如果要拿来用的话,请自行验证。
好了,今天就分享到这里,谢谢大家,我们下期再会。
联系客服