Edward said:
I am about to try to write a sub that displays Words' colour-selector
dialog and returns the colour (code) selected
ISTM that this MUST have already been written? Anyone know of a
source?
Eddie
Hi Eddie,
Sure... I happened to have this one lying around. Make a userform with two
command buttons on it, CommandButton1 labeled "Choose Color" and
CommandButton2 labeled "Cancel". Then throw this code into it.
Private Type CHOOSECOLOR
lStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As String
Flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Dim CustomColors() As Byte
Private Declare Function ChooseColorAPI Lib "comdlg32.dll" Alias _
"ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Function GetWinwordHwnd() As Long
Dim hWnd As Long
hWnd = FindWindow("opusApp", vbNullString)
GetWinwordHwnd = hWnd
End Function
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub CommandButton1_Click()
Dim cc As CHOOSECOLOR
Dim lReturn As Long, Rval As Long
Dim Gval As Long, Bval As Long
Dim i As Integer
cc.lStructSize = Len(cc)
cc.hwndOwner = GetWinwordHwnd()
cc.hInstance = 0
cc.lpCustColors = StrConv(CustomColors, vbUnicode)
cc.Flags = 0
' call the color picker
lReturn = ChooseColorAPI(cc)
If lReturn <> 0 Then
' extract the color values
Rval = cc.rgbResult Mod 256
Bval = Int(cc.rgbResult / 65536)
Gval = Int((cc.rgbResult - (Bval * 65536) - Rval) / 256)
' display the values in the dialog title bar
Me.Caption = "RGB Value User Chose: R=" & Str$(Rval) & _
" G=" & Str$(Gval) & " B=" & Str$(Bval)
' change the dialog background to that color
Me.BackColor = cc.rgbResult
' save the color values to send to the
' color picker for the next iteration
CustomColors = StrConv(cc.lpCustColors, vbFromUnicode)
ReDim CustomColors(0 To 16 * 4 - 1) As Byte
For i = LBound(CustomColors) To UBound(CustomColors)
CustomColors(i) = 0
Next i
Else
MsgBox "User chose the Cancel Button"
End If
End Sub
Private Sub UserForm_Load()
ReDim CustomColors(0 To 16 * 4 - 1) As Byte
Dim i As Integer
For i = LBound(CustomColors) To UBound(CustomColors)
CustomColors(i) = 0
Next i
End Sub
Private Sub UserForm_Layout()
Me.Move 150, 100
End Sub
