MS Word VBA：我需要一个调色板对话框

Question

在VBA for MS Word 2010中，如何让Word调出一个调色板对话框，以便用户可以选择颜色？

有很多关于如何在Excel中执行此操作的示例，但我没有找到Word用户的任何帮助。这是Excel的代码：

Application.Dialogs(xlDialogPatterns).Show

问题是，没有相应的wdDialogPatterns，也无法找到任何带有建议调色板对话框名称的内容。我找到了wdFormatBordersAndShading，但它并不完全相同：我希望用户选择一种颜色供以后重复使用。

谢谢！

Answer 1

在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

Private Declare PtrSafe Function VarPtrArray _
  Lib "VBE7" Alias _
  "VarPtr" (ByRef Var() As Any) As LongPtr

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

例如，使用TextColor对象的Font属性函数：

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。

Answer 2

据我所知，Word与Excel中没有相同的选项。 相反，您可以通过.dll调用Windows内置解决方案。 我最近创建了一个，以便能够选择更多的颜色作为文本背景颜色。

快速访问Windows文档，您可以在其中看到可以修改的所有选项： https://msdn.microsoft.com/en-us/library/windows/desktop/ms646830(v=vs.85).aspx 提示：CC_ANYCOLOR = 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