| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA and Colorwheel
I need a code example to allow the user to p;ick a color from within the
excel color wheel using VBA. I have not been able to find one so far. Thanks |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
VBA and Colorwheel
Sub Foo()
Application.Dialogs(xlDialogPatterns).Show End Sub Will pop up the color picker dialog and color the selection with whatever color is picked. Gord Dibben MS Excel MVP On Wed, 19 Dec 2007 14:16:04 -0800, lwm wrote: I need a code example to allow the user to p;ick a color from within the excel color wheel using VBA. I have not been able to find one so far. Thanks |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
VBA and Colorwheel
Thanks
This ansered my question but how do I use this to fill a variable if I put x = Application.Dialogs(xlDialogPatterns).Show msgbox x I recieve true. I need to be able to use the variable in other statemnts like changing font color. "Gord Dibben" wrote: Sub Foo() Application.Dialogs(xlDialogPatterns).Show End Sub Will pop up the color picker dialog and color the selection with whatever color is picked. Gord Dibben MS Excel MVP On Wed, 19 Dec 2007 14:16:04 -0800, lwm wrote: I need a code example to allow the user to p;ick a color from within the excel color wheel using VBA. I have not been able to find one so far. Thanks |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
VBA and Colorwheel
There is no easy way to directly do what you ask. The show method takes a
number of arguments but I believe taht the argument are passed in by value and not bey reference so they are not modified when the code is execulted. The argument for the colour is Arg3 so if you execute the code like this then No colour is always the default selection... Application.Dialogs(xlDialogPatterns).Show Arg3:=0 You cna however get the colour indirectly. Since the dialog colours the active cell you just need to read the colour of the cell immediatly following the colour selection. So perhaps something like this... dim x as long dim y as long x = activecell.interior.colorindex Application.Dialogs(xlDialogPatterns).Show Arg3:=0 y = activecell.interior.colorindex activecell.interior.colorindex = x The only trick here is to make sure that only one cell is selected when this code is run... -- HTH... Jim Thomlinson "lwm" wrote: Thanks This ansered my question but how do I use this to fill a variable if I put x = Application.Dialogs(xlDialogPatterns).Show msgbox x I recieve true. I need to be able to use the variable in other statemnts like changing font color. "Gord Dibben" wrote: Sub Foo() Application.Dialogs(xlDialogPatterns).Show End Sub Will pop up the color picker dialog and color the selection with whatever color is picked. Gord Dibben MS Excel MVP On Wed, 19 Dec 2007 14:16:04 -0800, lwm wrote: I need a code example to allow the user to p;ick a color from within the excel color wheel using VBA. I have not been able to find one so far. Thanks |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
VBA and Colorwheel
If I use this code
Sub Foo() Dim x As Integer Dim y As Integer x = ActiveCell.Interior.ColorIndex Application.Dialogs(xlDialogPatterns).Show Arg3:=0 y = ActiveCell.Interior.ColorIndex ActiveCell.Interior.ColorIndex = x Range("b5").Select Selection.Font.ColorIndex = x End Sub I get the infamous 1004 on the Selection.Font.ColorIndex = x If I use double instead of integer for the dim I get the 1004 error at ActiveCell.Interior.ColorIndex = x I want to change the font color at b5. Thanks "Jim Thomlinson" wrote: There is no easy way to directly do what you ask. The show method takes a number of arguments but I believe taht the argument are passed in by value and not bey reference so they are not modified when the code is execulted. The argument for the colour is Arg3 so if you execute the code like this then No colour is always the default selection... Application.Dialogs(xlDialogPatterns).Show Arg3:=0 You cna however get the colour indirectly. Since the dialog colours the active cell you just need to read the colour of the cell immediatly following the colour selection. So perhaps something like this... dim x as long dim y as long x = activecell.interior.colorindex Application.Dialogs(xlDialogPatterns).Show Arg3:=0 y = activecell.interior.colorindex activecell.interior.colorindex = x The only trick here is to make sure that only one cell is selected when this code is run... -- HTH... Jim Thomlinson "lwm" wrote: Thanks This ansered my question but how do I use this to fill a variable if I put x = Application.Dialogs(xlDialogPatterns).Show msgbox x I recieve true. I need to be able to use the variable in other statemnts like changing font color. "Gord Dibben" wrote: Sub Foo() Application.Dialogs(xlDialogPatterns).Show End Sub Will pop up the color picker dialog and color the selection with whatever color is picked. Gord Dibben MS Excel MVP On Wed, 19 Dec 2007 14:16:04 -0800, lwm wrote: I need a code example to allow the user to p;ick a color from within the excel color wheel using VBA. I have not been able to find one so far. Thanks |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
VBA and Colorwheel
You want to set it to y and not x. Give this a try...
Sub Foo() Dim x As Integer Dim y As Integer x = ActiveCell.Interior.ColorIndex 'Store original color Application.Dialogs(xlDialogPatterns).Show Arg3:=0 y = ActiveCell.Interior.ColorIndex 'Get selected color ActiveCell.Interior.ColorIndex = x 'Restore original color Range("b5").Font.ColorIndex = y 'Set font to selected color End Sub -- HTH... Jim Thomlinson "lwm" wrote: If I use this code Sub Foo() Dim x As Integer Dim y As Integer x = ActiveCell.Interior.ColorIndex Application.Dialogs(xlDialogPatterns).Show Arg3:=0 y = ActiveCell.Interior.ColorIndex ActiveCell.Interior.ColorIndex = x Range("b5").Select Selection.Font.ColorIndex = x End Sub I get the infamous 1004 on the Selection.Font.ColorIndex = x If I use double instead of integer for the dim I get the 1004 error at ActiveCell.Interior.ColorIndex = x I want to change the font color at b5. Thanks "Jim Thomlinson" wrote: There is no easy way to directly do what you ask. The show method takes a number of arguments but I believe taht the argument are passed in by value and not bey reference so they are not modified when the code is execulted. The argument for the colour is Arg3 so if you execute the code like this then No colour is always the default selection... Application.Dialogs(xlDialogPatterns).Show Arg3:=0 You cna however get the colour indirectly. Since the dialog colours the active cell you just need to read the colour of the cell immediatly following the colour selection. So perhaps something like this... dim x as long dim y as long x = activecell.interior.colorindex Application.Dialogs(xlDialogPatterns).Show Arg3:=0 y = activecell.interior.colorindex activecell.interior.colorindex = x The only trick here is to make sure that only one cell is selected when this code is run... -- HTH... Jim Thomlinson "lwm" wrote: Thanks This ansered my question but how do I use this to fill a variable if I put x = Application.Dialogs(xlDialogPatterns).Show msgbox x I recieve true. I need to be able to use the variable in other statemnts like changing font color. "Gord Dibben" wrote: Sub Foo() Application.Dialogs(xlDialogPatterns).Show End Sub Will pop up the color picker dialog and color the selection with whatever color is picked. Gord Dibben MS Excel MVP On Wed, 19 Dec 2007 14:16:04 -0800, lwm wrote: I need a code example to allow the user to p;ick a color from within the excel color wheel using VBA. I have not been able to find one so far. Thanks |
|
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
VBA and Colorwheel
Try this code, all in a normal module:
Option Explicit Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long Private Declare Function SetWindowText Lib "user32" _ Alias "SetWindowTextA" _ (ByVal hWnd As Long, _ ByVal lpString As String) As Long Private Declare Function ChooseColor Lib "comdlg32.dll" _ Alias "ChooseColorA" _ (lpcc As CHOOSECOLORSTRUCT) As Long Private Const WM_INITDIALOG As Long = &H110 'static array to contain the custom 'colours selected by the user Private dwCustClrs(0 To 15) As Long 'ChooseColor structure flag constants Private Const CC_RGBINIT As Long = &H1 Private Const CC_FULLOPEN As Long = &H2 Private Const CC_ENABLEHOOK As Long = &H10 Private Const CC_ANYCOLOR As Long = &H100 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 strClrPickerTitle As String Function GetColour(lStartColour As Long, _ strWindowTitle As String, _ adjustText As Boolean) As Long Dim CC As CHOOSECOLORSTRUCT Dim CNT As Long strClrPickerTitle = strWindowTitle 'populate the custom colours 'with a series of gray shades For CNT = 240 To 15 Step -15 dwCustClrs((CNT \ 15) - 1) = RGB(CNT, CNT, CNT) Next CNT With CC 'base flag .flags = CC_ANYCOLOR .flags = .flags Or CC_FULLOPEN .flags = .flags Or CC_RGBINIT .rgbResult = lStartColour .flags = .flags Or CC_ENABLEHOOK .lpfnHook = FARPROC(AddressOf ChooseColorProc) 'size of structure .lStructSize = Len(CC) 'assign the custom colour selections .lpCustColors = VarPtr(dwCustClrs(0)) End With If ChooseColor(CC) = 1 Then 'return the long colour '---------------------- GetColour = CC.rgbResult Else 'return the colour you started with '---------------------------------- GetColour = lStartColour End If End Function Function FARPROC(ByVal pfn As Long) As Long 'Procedure that receives and returns 'the passed value of the AddressOf operator. 'This workaround is needed as you can't assign 'AddressOf directly to a member of a user- 'defined type, but you can assign it to another 'long and use that (as returned here) FARPROC = pfn End Function Function ChooseColorProc(ByVal hWnd As Long, _ ByVal uMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long If uMsg = WM_INITDIALOG Then 'customize the dialog caption Call SetWindowText(hWnd, strClrPickerTitle) ChooseColorProc = 1 End If End Function Sub test() MsgBox GetColour(0, "just testing", True) End Sub RBS "lwm" wrote in message ... Thanks This ansered my question but how do I use this to fill a variable if I put x = Application.Dialogs(xlDialogPatterns).Show msgbox x I recieve true. I need to be able to use the variable in other statemnts like changing font color. "Gord Dibben" wrote: Sub Foo() Application.Dialogs(xlDialogPatterns).Show End Sub Will pop up the color picker dialog and color the selection with whatever color is picked. Gord Dibben MS Excel MVP On Wed, 19 Dec 2007 14:16:04 -0800, lwm wrote: I need a code example to allow the user to p;ick a color from within the excel color wheel using VBA. I have not been able to find one so far. Thanks |
|
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
VBA and Colorwheel
Thanks
That works "Jim Thomlinson" wrote: You want to set it to y and not x. Give this a try... Sub Foo() Dim x As Integer Dim y As Integer x = ActiveCell.Interior.ColorIndex 'Store original color Application.Dialogs(xlDialogPatterns).Show Arg3:=0 y = ActiveCell.Interior.ColorIndex 'Get selected color ActiveCell.Interior.ColorIndex = x 'Restore original color Range("b5").Font.ColorIndex = y 'Set font to selected color End Sub -- HTH... Jim Thomlinson "lwm" wrote: If I use this code Sub Foo() Dim x As Integer Dim y As Integer x = ActiveCell.Interior.ColorIndex Application.Dialogs(xlDialogPatterns).Show Arg3:=0 y = ActiveCell.Interior.ColorIndex ActiveCell.Interior.ColorIndex = x Range("b5").Select Selection.Font.ColorIndex = x End Sub I get the infamous 1004 on the Selection.Font.ColorIndex = x If I use double instead of integer for the dim I get the 1004 error at ActiveCell.Interior.ColorIndex = x I want to change the font color at b5. Thanks "Jim Thomlinson" wrote: There is no easy way to directly do what you ask. The show method takes a number of arguments but I believe taht the argument are passed in by value and not bey reference so they are not modified when the code is execulted. The argument for the colour is Arg3 so if you execute the code like this then No colour is always the default selection... Application.Dialogs(xlDialogPatterns).Show Arg3:=0 You cna however get the colour indirectly. Since the dialog colours the active cell you just need to read the colour of the cell immediatly following the colour selection. So perhaps something like this... dim x as long dim y as long x = activecell.interior.colorindex Application.Dialogs(xlDialogPatterns).Show Arg3:=0 y = activecell.interior.colorindex activecell.interior.colorindex = x The only trick here is to make sure that only one cell is selected when this code is run... -- HTH... Jim Thomlinson "lwm" wrote: Thanks This ansered my question but how do I use this to fill a variable if I put x = Application.Dialogs(xlDialogPatterns).Show msgbox x I recieve true. I need to be able to use the variable in other statemnts like changing font color. "Gord Dibben" wrote: Sub Foo() Application.Dialogs(xlDialogPatterns).Show End Sub Will pop up the color picker dialog and color the selection with whatever color is picked. Gord Dibben MS Excel MVP On Wed, 19 Dec 2007 14:16:04 -0800, lwm wrote: I need a code example to allow the user to p;ick a color from within the excel color wheel using VBA. I have not been able to find one so far. Thanks |
|
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
VBA and Colorwheel
Rb
This works but is way beyond my current understanding. I will study it and see if I can figure it out. Thanks "RB Smissaert" wrote: Try this code, all in a normal module: Option Explicit Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long Private Declare Function SetWindowText Lib "user32" _ Alias "SetWindowTextA" _ (ByVal hWnd As Long, _ ByVal lpString As String) As Long Private Declare Function ChooseColor Lib "comdlg32.dll" _ Alias "ChooseColorA" _ (lpcc As CHOOSECOLORSTRUCT) As Long Private Const WM_INITDIALOG As Long = &H110 'static array to contain the custom 'colours selected by the user Private dwCustClrs(0 To 15) As Long 'ChooseColor structure flag constants Private Const CC_RGBINIT As Long = &H1 Private Const CC_FULLOPEN As Long = &H2 Private Const CC_ENABLEHOOK As Long = &H10 Private Const CC_ANYCOLOR As Long = &H100 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 strClrPickerTitle As String Function GetColour(lStartColour As Long, _ strWindowTitle As String, _ adjustText As Boolean) As Long Dim CC As CHOOSECOLORSTRUCT Dim CNT As Long strClrPickerTitle = strWindowTitle 'populate the custom colours 'with a series of gray shades For CNT = 240 To 15 Step -15 dwCustClrs((CNT \ 15) - 1) = RGB(CNT, CNT, CNT) Next CNT With CC 'base flag .flags = CC_ANYCOLOR .flags = .flags Or CC_FULLOPEN .flags = .flags Or CC_RGBINIT .rgbResult = lStartColour .flags = .flags Or CC_ENABLEHOOK .lpfnHook = FARPROC(AddressOf ChooseColorProc) 'size of structure .lStructSize = Len(CC) 'assign the custom colour selections .lpCustColors = VarPtr(dwCustClrs(0)) End With If ChooseColor(CC) = 1 Then 'return the long colour '---------------------- GetColour = CC.rgbResult Else 'return the colour you started with '---------------------------------- GetColour = lStartColour End If End Function Function FARPROC(ByVal pfn As Long) As Long 'Procedure that receives and returns 'the passed value of the AddressOf operator. 'This workaround is needed as you can't assign 'AddressOf directly to a member of a user- 'defined type, but you can assign it to another 'long and use that (as returned here) FARPROC = pfn End Function Function ChooseColorProc(ByVal hWnd As Long, _ ByVal uMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long If uMsg = WM_INITDIALOG Then 'customize the dialog caption Call SetWindowText(hWnd, strClrPickerTitle) ChooseColorProc = 1 End If End Function Sub test() MsgBox GetColour(0, "just testing", True) End Sub RBS "lwm" wrote in message ... Thanks This ansered my question but how do I use this to fill a variable if I put x = Application.Dialogs(xlDialogPatterns).Show msgbox x I recieve true. I need to be able to use the variable in other statemnts like changing font color. "Gord Dibben" wrote: Sub Foo() Application.Dialogs(xlDialogPatterns).Show End Sub Will pop up the color picker dialog and color the selection with whatever color is picked. Gord Dibben MS Excel MVP On Wed, 19 Dec 2007 14:16:04 -0800, lwm wrote: I need a code example to allow the user to p;ick a color from within the excel color wheel using VBA. I have not been able to find one so far. Thanks |
|
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
VBA and Colorwheel
I don't think I understand all myself, but you don't have to.
Application.Dialogs(xlDialogPatterns).Show does probably exactly the same under the bonnet. Using the API gives you more flexibility, but if you don't need it then I would go with the Application.Dialogs RBS "lwm" wrote in message ... Rb This works but is way beyond my current understanding. I will study it and see if I can figure it out. Thanks "RB Smissaert" wrote: Try this code, all in a normal module: Option Explicit Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long Private Declare Function SetWindowText Lib "user32" _ Alias "SetWindowTextA" _ (ByVal hWnd As Long, _ ByVal lpString As String) As Long Private Declare Function ChooseColor Lib "comdlg32.dll" _ Alias "ChooseColorA" _ (lpcc As CHOOSECOLORSTRUCT) As Long Private Const WM_INITDIALOG As Long = &H110 'static array to contain the custom 'colours selected by the user Private dwCustClrs(0 To 15) As Long 'ChooseColor structure flag constants Private Const CC_RGBINIT As Long = &H1 Private Const CC_FULLOPEN As Long = &H2 Private Const CC_ENABLEHOOK As Long = &H10 Private Const CC_ANYCOLOR As Long = &H100 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 strClrPickerTitle As String Function GetColour(lStartColour As Long, _ strWindowTitle As String, _ adjustText As Boolean) As Long Dim CC As CHOOSECOLORSTRUCT Dim CNT As Long strClrPickerTitle = strWindowTitle 'populate the custom colours 'with a series of gray shades For CNT = 240 To 15 Step -15 dwCustClrs((CNT \ 15) - 1) = RGB(CNT, CNT, CNT) Next CNT With CC 'base flag .flags = CC_ANYCOLOR .flags = .flags Or CC_FULLOPEN .flags = .flags Or CC_RGBINIT .rgbResult = lStartColour .flags = .flags Or CC_ENABLEHOOK .lpfnHook = FARPROC(AddressOf ChooseColorProc) 'size of structure .lStructSize = Len(CC) 'assign the custom colour selections .lpCustColors = VarPtr(dwCustClrs(0)) End With If ChooseColor(CC) = 1 Then 'return the long colour '---------------------- GetColour = CC.rgbResult Else 'return the colour you started with '---------------------------------- GetColour = lStartColour End If End Function Function FARPROC(ByVal pfn As Long) As Long 'Procedure that receives and returns 'the passed value of the AddressOf operator. 'This workaround is needed as you can't assign 'AddressOf directly to a member of a user- 'defined type, but you can assign it to another 'long and use that (as returned here) FARPROC = pfn End Function Function ChooseColorProc(ByVal hWnd As Long, _ ByVal uMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long If uMsg = WM_INITDIALOG Then 'customize the dialog caption Call SetWindowText(hWnd, strClrPickerTitle) ChooseColorProc = 1 End If End Function Sub test() MsgBox GetColour(0, "just testing", True) End Sub RBS "lwm" wrote in message ... Thanks This ansered my question but how do I use this to fill a variable if I put x = Application.Dialogs(xlDialogPatterns).Show msgbox x I recieve true. I need to be able to use the variable in other statemnts like changing font color. "Gord Dibben" wrote: Sub Foo() Application.Dialogs(xlDialogPatterns).Show End Sub Will pop up the color picker dialog and color the selection with whatever color is picked. Gord Dibben MS Excel MVP On Wed, 19 Dec 2007 14:16:04 -0800, lwm wrote: I need a code example to allow the user to p;ick a color from within the excel color wheel using VBA. I have not been able to find one so far. Thanks |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Linear Mode
