[求助]用vba 如何取得word的背景颜色呢

nanhoo

rt

守柔

请测试：

－－－－－－－－－－－－－－－－－－－－－

Option Explicit

Sub Test()
Dim myColor As Long
myColor = ActiveDocument.Background.Fill.ForeColor.RGB
MsgBox GetColor(myColor)
End Sub
'----------------------
Function GetColor(Color As Long) As String
Select Case Color
Case Is = -16777216
GetColor = "自动色"
Case Is = 0
GetColor = "黑色"
Case Is = 13209
GetColor = "褐色"
Case Is = 13107
GetColor = "橄榄绿"
Case Is = 13056
GetColor = "深绿"
Case Is = 6697728
GetColor = "深灰蓝"
Case Is = 8388608
GetColor = "深蓝"
Case Is = 10040115
GetColor = "靛蓝"
Case Is = 3355443
GetColor = "灰色-80%"
Case Is = 128
GetColor = "深红"
Case Is = 26367
GetColor = "桔黄"
Case Is = 32896
GetColor = "深黄"
Case Is = 32768
GetColor = "绿色"
Case Is = 8421376
GetColor = "蓝绿色"
Case Is = 16711680
GetColor = "蓝色"
Case Is = 10053222
GetColor = "蓝-灰"
Case Is = 8421504
GetColor = "灰色-50%"
Case Is = 255
GetColor = "红色"
Case Is = 39423
GetColor = "浅桔黄"
Case Is = 52377
GetColor = "酸橙色"
Case Is = 6723891
GetColor = "海绿"
Case Is = 13421619
GetColor = "宝石蓝"
Case Is = 16737843
GetColor = "浅蓝"
Case Is = 8388736
GetColor = "紫色"
Case Is = 10066329
GetColor = "灰色-40%"
Case Is = 16711935
GetColor = "粉红"
Case Is = 52479
GetColor = "金色"
Case Is = 65535
GetColor = "黄色"
Case Is = 65280
GetColor = "鲜绿"
Case Is = 16776960
GetColor = "青绿"
Case Is = 16763904
GetColor = "天蓝"
Case Is = 6697881
GetColor = "梅红"
Case Is = 12632256
GetColor = "灰色"
Case Is = 13408767
GetColor = "玫瑰红"
Case Is = 10079487
GetColor = "棕黄"
Case Is = 10092543
GetColor = "浅黄"
Case Is = 13434828
GetColor = "浅绿"
Case Is = 16777164
GetColor = "浅青绿"
Case Is = 16764057
GetColor = "淡蓝"
Case Is = 16751052
GetColor = "淡紫"
Case Is = 16777215
GetColor = "白色"
End Select
End Function
'----------------------

konggs

Sub 这个行否()
Dim rgb1
rgb1 = ActiveDocument.Background.Fill.ForeColor.RGB
bbb (rgb1)
End Sub
Function bbb(rgb1)
Dim Col As String
Dim R, G, B
Dim dd

'由于出来的是不完整数据,所以在下面做填补
Col = Hex(rgb1)
'判断有多少位,然后保持结果是6位数的
Select Case Len(Col)
Case 6
dd = Col
Case 5
dd = "0" + Col
Case 4
dd = "00" + Col
Case 3
dd = "000" + Col
Case 2
dd = "0000" + Col
Case 1
dd = "00000" + Col
End Select
'16进的颜色格式是 &H BB GG RR,下面提取RGB,然后变回10进
R = CLng("&H" & Right(dd, 2))
G = CLng("&H" & Mid(Left(dd, 4), 3))
B = CLng("&H" & Left(dd, 2))

MsgBox "当前的背景色RGB颜色是:" & R & "," & G & "," & B

End Function