繁体   English   中英

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

[英]MS Word VBA: I need a color palette dialog box

在 MS Word 2010 的 VBA 中,如何让 Word 调出调色板对话框以便用户可以选择颜色?

在此处输入图片说明

有很多关于如何在 Excel 中执行此操作的示例,但我还没有找到对 Word 用户的任何帮助。 Excel的代码如下:

Application.Dialogs(xlDialogPatterns).Show

问题是,没有 wdDialogPatterns 等效项,我也找不到任何名称暗示调色板对话框的内容。 我找到了 wdFormatBordersAndShading,但它并不完全相同:我希望用户选择一种颜色供以后重复使用。

谢谢!

据我所知,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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM