ColorIndex of the current application
And what happens in 2007?
--
HTH
Bob
(there's no email, no snail mail, but somewhere should be gmail in my addy)
"NickHK" wrote in message
...
Peter,
OK, thanks for that.
Yes, undocking the palette, then closing it sets the ToolTipText to
"Custom", but then if you do anything and come back, it has reset to the
default. Agghhh.
All this does seem to be unnecessarily complex, especially as there is
always a set of 56 colours.
Thinking about it now, SendMessage is probably no better, as you have to
include the mouse click coords in the parameters. I'll check out that code
you posted.
NickHK
"Peter T" <peter_t@discussions wrote in message
...
Hi again,
If the colour has been customized the tooltip name doesn't always
update
from a colour name to "Custom", so could return incorrectly
This is what I find. ToolTipsText for custom colours are never updated.
I find they normally update eventually and Tooltip reads "Custom",
perhaps
after a save. If you drag the control off the toolbar the names
immediately
update, at least for me, to read "Scheme Color".
(other ways to verify that).
Care to elaborate ?
Check if the palette is customized, and if so which colours
' print the default palette to the immediate window
Sub DefaualtPalette()
Dim i&, s$, P
Workbooks.Add ' to be sure it has a default palette
s = "arrDefPal = Array("
P = ActiveWorkbook.Colors
For i = 1 To 56
s = s & P(i)
If i = 56 Then
s = s & ")"
Else
s = s & ", "
End If
Next
Debug.Print s
End Sub
Function HasCustomPalette(wb As Workbook, bArr() As Boolean)
Dim arrDefPal, P, bFlag As Boolean
' arrDefPal = Array(0, 16777215, 255, etc.... ' copy the printout from
DefaualtPalette()
P = wb.Colors
For i = 1 To 56
If P(i) < arrDefPal(i - 1) Then
bArr(i) = True
bFlag = True
End If
Next
HasCustomPalette = bFlag
End Function
Sub test()
Dim bArrCustom(1 To 56) As Boolean
Dim bRes As Boolean
ActiveWorkbook.Colors(6) = 12345678
bRes = HasCustomPalette(ActiveWorkbook, bArrCustom)
If bRes Then
MsgBox "wb palette is customized" & vbCr & _
"ColorIndex 6 customized " & bArrCustom(6)
Else
MsgBox "Default palette"
End If
End Sub
Adapt my previous routine and place the colour-name & colorvalue lookup
tables in colorindex order, everything required for the task is
available.
Regards,
Peter T
"NickHK" wrote in message
...
Peter,
If the colour has been customized the tooltip name doesn't always
update
from a colour name to "Custom", so could return incorrectly
This is what I find. ToolTipsText for custom colours are never updated.
(other ways to verify that).
Care to elaborate ?
NickHK
"Peter T" <peter_t@discussions wrote in message
...
Indeed you can get the colour name from the tooltip, so can get the
colour
value from a lookup table (and/or index if the tables are in correct
order -
unlike below).
Following is significantly reduced from something else I have. As
written
assumes a default palette (for other reasons the arrays are in colour
value
order). For your purposes it would be better to arrange in color
index
order, then could return the index directly with the lookup.
The reverse lookup, colour name from color value (see GetColourName),
does
not require the palette colours to be in default positions.
If the colour has been customized the tooltip name doesn't always
update
from a colour name to "Custom", so could return incorrectly (other
ways
to
verify that). Also, is say default red is in the default posistion
for
default blue, the tooltip may continue to read Blue. There are other
issues
too, IOW caveats!
Function CvalCNames(nClrVal As Long, sName As String) As Boolean
Dim i As Long
Dim vN, vS
' 46/56 colours, excl the 10 duplicate chart colours
vN = Array(xlAutomatic, 0, 128&, 255&, 13056&, 13107&, 13209&,
26367&,
_
32768, 32896, 39423, 52377, 52479, 65280, 65535, 3355443, 6684774,
6697728,
_
6697881, 6723891, 8388608, 8388736, 8421376, 8421504, 8421631,
9868950,
_
10040115, 10053222, 10079487, 10092543, 12632256, 13395456, 13408767,
_
13421619, 13434828, 13434879, 16711680, 16711935, 16737843, 16751001,
_
16751052, 16763904, 16764057, 16764108, 16776960, 16777164, 16777215)
vS = Array("Automatic", "Black", "Dark Red", "Red", "Dark Green", _
"Olive Green", "Brown", "Orange", "Green", "Dark Yellow", "Light
Orange",
_
"Lime", "Gold", "Bright Green", "Yellow", "Gray-80%", "Dark Purple",
_
"Dark Teal", "Plum", "Sea Green", "Dark Blue", "Violet", "Teal", _
"Gray-50%", "Coral", "Gray-40%", "Indigo", "Blue-Gray", "Tan", _
"Light Yellow", "Gray-25%", "Ocean Blue", "Rose", "Aqua", "Light
Green",
_
"Ivory", "Blue", "Pink", "Light Blue", "Periwinkle", "Lavender", _
"Sky Blue", "Pale Blue", "Ice Blue", "Turqoise", "Light Turquiose",
"White")
If Len(sName) Then
For i = 0 To UBound(vS)
If sName = vS(i) Then
nClrVal = vN(i)
Exit For
End If
Next
Else
For i = 0 To UBound(vN)
If nClrVal = vN(i) Then
sName = vS(i)
Exit For
End If
Next
End If
CvalCNames = i <= UBound(vN)
End Function
Sub ApplyToolBarFillColor()
Dim sName As String, nClrValue As Long
sName = Application.CommandBars("Formatting"). _
Controls("Fill Color").TooltipText
sName = Mid(sName, InStr(1, sName, "(") + 1, 30)
sName = Left(sName, Len(sName) - 1)
If CvalCNames(nClrValue, sName) Then
If nClrValue < 1 Then
ActiveCell.Interior.ColorIndex = xlAutomatic
Else
ActiveCell.Interior.Color = nClrValue
End If
Else
MsgBox "Custom or non-English colour names"
End If
GetColourName
End Sub
Sub GetColourName()
Dim idx As Long, sName As String, nClrValue As Long
With ActiveCell.Interior
nClrValue = .Color
idx = .ColorIndex
End With
If CvalCNames(nClrValue, sName) Then
MsgBox idx & " " & sName
Else
MsgBox "Custom or non-English colour names"
End If
End Sub
Regards,
Peter T
"JasonF" wrote in message
ups.com...
Is there a way to determine what the current / last used color
index
number is from VBA? Instead of hard coding the colorindex or
forcing
the user to choose a color, I would like to just pick up the color
that's currently in the toolbar? I've found the name:
Application.CommandBars("Formatting").Controls("Fi ll
Color").TooltipText
However, I'd like to get the ColorIndex number for the name. Any
ideas?
|