MS Word VBA: I need a color palette dialog box

user_5919453 0
Viewed 2267

In VBA for MS Word 2010, how can I get Word to bring up a color palette dialog box so the user can pick a color?

enter image description here

There are tons of examples on how to do it in Excel, but I haven't found any help for Word users. Here's the code for Excel:

Application.Dialogs(xlDialogPatterns).Show

Problem is, there's no wdDialogPatterns equivalent, nor can I find anything with a name that suggests a color palette dialog. I've found wdFormatBordersAndShading, but it's not quite the same: I want the user to select a color for later and repeated use.

Thanks!

word-2010 color-picker ms-word dialog vba
2 Answers

As far as I know Word does not have the same option as in Excel.
Instead you can call a Windows inbuilt solution via .dll.
I have recently created one in order to be able to pick more colors as text background color.

Fisrtly the Windows documentation where you can see all the options you can modify:
https://msdn.microsoft.com/en-us/library/windows/desktop/ms646830(v=vs.85).aspx
Hint: CC_ANYCOLOR = 0x00000100 = &H100 (You need to use this form in VBA)

From my code example you can see how to implement it:
This goes top of Module: 

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

This is the picker caller function with optionally submitted 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

And finally this is how you call it in action: 

Sub F_HáttérSzínVálasztó()
    With Selection.Font.Shading
        .BackgroundPatternColor = PickColor(Selection.Font.Shading.BackgroundPatternColor)
    End With
End Sub
user_58929970

On x64 Word you must modify Ádám's code below as follows:

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

Use the function for example with the TextColor property of a Font object:

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

Please note, that the GetColor function requires a parameter of type LongLong whereas the TextColor.rgb property is of type Long.

user_74530650
Related