[英]MS Word VBA: I need a color palette dialog box
据我所知,Word 没有与 Excel 相同的选项。
相反,您可以通过 .dll 调用 Windows 内置解决方案。
我最近创建了一个,以便能够选择更多颜色作为文本背景颜色。
首先是 Windows 文档,您可以在其中看到所有可以修改的选项:
https://msdn.microsoft.com/en-us/library/windows/desktop/ms646830(v=vs.85).aspx
提示:CC_ANYOLOR = 0x00000100 = &H100(你需要在 VBA 中使用这种形式)
从我的代码示例中您可以看到如何实现它:
这是模块的顶部:
Private Type CHOOSECOLORSTRUCT
lStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As Long
flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Declare Function ChooseColor Lib "comdlg32.dll" _
Alias "ChooseColorA" _
(lpcc As CHOOSECOLORSTRUCT) As Long
这是带有可选提交的 OriginalColor 的选择器调用函数:
Public Function PickColor(Optional OriginalColor As Variant = 8421376) 'You can define any colour as default instead of 8421376)
Dim cc As CHOOSECOLORSTRUCT
Dim dwCustClrs(0 To 15) As Long
With cc
.Flags = &H100 Or &H1 Or &H2
.lStructSize = Len(cc)
.hwndOwner = 0
.lpCustColors = VarPtr(dwCustClrs(0))
.rgbResult = OriginalColor
End With
If CHOOSECOLOR(cc) = 1 Then
PickColor = cc.rgbResult
End If
End Function
最后,这就是您在实际中调用它的方式:
Sub F_HáttérSzínVálasztó()
With Selection.Font.Shading
.BackgroundPatternColor = PickColor(Selection.Font.Shading.BackgroundPatternColor)
End With
End Sub
在 x64 Word 上,您必须按如下方式修改 Ádám 的代码:
Option Explicit
Option Base 0
Private Type CHOOSECOLOR
lStructSize As LongLong
hwndOwner As LongPtr
hInstance As LongPtr
rgbResult As LongLong
lpCustColors As LongPtr
flags As LongLong
lCustData As LongLong
lpfnHook As LongLong
lpTemplateName As String
End Type
Private Declare PtrSafe Function MyChooseColor _
Lib "comdlg32.dll" Alias "ChooseColorW" _
(ByRef pChoosecolor As CHOOSECOLOR) As Boolean
Public Function GetColor(ByRef col As LongLong) As _
Boolean
Static CS As CHOOSECOLOR
Static CustColor(15) As LongLong
CS.lStructSize = Len(CS)
CS.hwndOwner = 0
CS.flags = &H1 Or &H2
CS.lpCustColors = VarPtr(CustColor(0))
CS.rgbResult = col
CS.hInstance = 0
GetColor = MyChooseColor(CS)
If GetColor = False Then Exit Function
GetColor = True
col = CS.rgbResult
End Function
例如,将该函数与Font
对象的TextColor
属性一起使用:
Sub FontColorTest()
Dim col As LongLong
col = rgb(200, 100, 50)
GetColor col
Dim p As Word.Paragraph
Set p = ActiveDocument.Paragraphs(1)
p.Range.Font.TextColor.rgb = CLng(col)
End Sub
请注意, GetColor
函数需要LongLong
类型的参数,而TextColor.rgb
属性的类型为Long
。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.