View Single Post
  #10   Report Post  
Posted to microsoft.public.excel.programming
Greg Wilson[_4_] Greg Wilson[_4_] is offline
external usenet poster
 
Posts: 218
Default Getting hWnd for API call or Color choosing dialog

Suggested is the following:

***** Step 1 *****
Create a Class module and paste the following code:

Public WithEvents ColorBtn As MSForms.Label
Private Sub ColorBtn_Click()
ColorBtn.SpecialEffect = fmSpecialEffectSunken
DoEvents
Sleep 100
ColorBtn.SpecialEffect = fmSpecialEffectFlat
ChosenColor = ColorBtn.BackColor
MsgBox "Your color choice was: " & ChosenColor
End Sub

***** Step 2 *****
Paste the following code to a standard module and run it
to create the UF. You only need to run it once. You can
delete the code after if you like. Correct for word wrap.

Sub MakeUF()
Dim UF As Object, NewFrame As Object, Ctrl As Object
Dim i As Integer, ii As Integer, iii As Integer
Dim Code As String, Line As Integer

Set UF = ThisWorkbook.VBProject.VBComponents.Add(3)
With UF
.Properties("Caption") = " Color selection"
.Properties("Height") = 112
.Properties("Width") = 110
End With
'***** Add LABELS for color selection *****
Set NewFrame = UF.Designer.Controls.Add("Forms.Frame.1")
With NewFrame
.Left = 3
.Top = 3
.Height = 87
.Width = 99
End With
iii = 0
For i = 0 To 6
For ii = 0 To 7
iii = iii + 1
Set Ctrl = NewFrame.Controls.Add("Forms.Label.1")
With Ctrl
.Left = ii * 12
.Top = i * 12
.Height = 12
.Width = 12
.BackColor = ActiveWorkbook.Colors(iii)
.Caption = ""
.ControlTipText = iii
.BorderStyle = 0
End With
Next
Next
With UF.CodeModule
Line = .CountOfLines
Code = "Dim ColorBtnGroup(1 To 56) As New Class1" &
vbCr & _
"Private Sub UserForm_Initialize()" & vbCr & _
"Dim i As Integer" & vbCr & _
"For i = 1 To 56" & vbCr & _
" Set ColorBtnGroup(i).ColorBtn = Controls(i)" &
vbCr & _
"Next" & vbCr & _
"End Sub"
.InsertLines Line, Code
End With
End Sub

***** Step 3 *****
Paste the following to a standard module. Correct word
wrap. Execute the macro UFShow to demo the color selector.
If the new UF is not named UserForm1 then correct the name.

Public Declare Sub Sleep Lib "kernel32.dll" (ByVal
dwMilliseconds As Long)
Public ChosenColor As Long

Sub UFShow()
UserForm1.Show
End Sub

Regards,
Greg