PDA

View Full Version : Sleeper: TAB color revisited



clvestin
09-09-2005, 05:42 AM
I'm sorry-little off subject-one question

How do you set the sheet Tab color on an excel sheet??
Thx in advance:dunno

Cyberdude
09-09-2005, 10:39 AM
Here's something I had thrown together for myself:


Sub SetSheetTabColorMac_Testerr()
Call SetSheetTabColorMac(Purple, "VBAHelp")
End Sub

Sub SetSheetTabColorMac(Optional TabColor As Variant = xlColorIndexNone, Optional ShtNm$) '6/26/05
Dim Msg$, CurrShtNm$
Const Title$ = "'TestX2.xls' (SetSheetTabColorMac)"
CurrShtNm = ActiveSheet.Name
If ShtNm = "" Then ShtNm = CurrShtNm
If TabColor = 0 Then TabColor = xlColorIndexNone
If Not IsNumeric(TabColor) _
Then TabColor = TranslateColorName(UCase(TabColor))
On Error GoTo InvalidColor
Worksheets(ShtNm).Tab.ColorIndex = TabColor
GoTo Finish
InvalidColor:
If Err <> 9 Then GoTo UnknownErr
On Error GoTo 0
Msg = "The specified tab color ('" & TabColor & "') is invalid." & vbCr & vbCr & _
"Valid color index numbers are 0 through 56," & vbCr & _
"where 0 (xlColorIndexNone) means default color." & vbCr & vbCr & _
"Terminating execution of this macro then continuing" & vbCr & _
"with execution of the calling macro (if any)."
MsgBox Msg, vbCritical, Title
GoTo Finish
UnknownErr:
Msg = "An unknown error occurred in " & Title & "." & vbCr & vbCr & _
"Err.Number = '" & Err & "'" & " Code = 2" & vbCr & _
"Err.Description = '" & Err.Description & "'"
On Error GoTo 0
MsgBox Msg, vbCritical, Title
Finish:
Worksheets(CurrShtNm).Select
End Sub 'SetSheetTabColorMac'

Function TranslateColorName(TabColor) As Integer
Select Case TabColor
Case "NOCOLOR": TranslateColorName = xlColorIndexNone
Case "BLACK": TranslateColorName = 1
Case "WHITE": TranslateColorName = 2
Case "RED": TranslateColorName = 3
Case "SPCLRED": TranslateColorName = 51
Case "SPCLREDDK": TranslateColorName = 38
Case "DKRED": TranslateColorName = 9
Case "GREEN": TranslateColorName = 4
Case "LTGREEN": TranslateColorName = 35
Case "DKGREEN": TranslateColorName = 10
Case "YELLOW": TranslateColorName = 6
Case "MAGENTA": TranslateColorName = 7
Case "CYAN": TranslateColorName = 8
Case "NO0GRAY": TranslateColorName = 12 'Special very light gray"
Case "NO1GRAY": TranslateColorName = 56 'Top (darkest) gray"
Case "NO2GRAY": TranslateColorName = 16 'Next to darkest gray"
Case "NO3GRAY": TranslateColorName = 48 'Next to lightest gray"
Case "NO4GRAY": TranslateColorName = 15 'Bottom (lightest) gray"
Case "LTGRAY": TranslateColorName = 15 '= No4Gray"
Case "VERYLTGRAY": TranslateColorName = 12 'Special very light gray"
Case "DKGRAY": TranslateColorName = 48 '= No3Gray"
Case "BLUE": TranslateColorName = 33
Case "DKBLUE": TranslateColorName = 5
Case "LTBLUE": TranslateColorName = 47
Case "AQUA": TranslateColorName = 42
Case "GOLD": TranslateColorName = 44
Case "LTYELLGRN": TranslateColorName = 40
Case "LTBROWN": TranslateColorName = 46
Case "DKBROWN": TranslateColorName = 45
Case "PINK": TranslateColorName = 55
Case "LTPINK": TranslateColorName = 38
Case "UTILVIOLET": TranslateColorName = 39
Case "VIOLET": TranslateColorName = 39
Case "ORANGE": TranslateColorName = 34
Case "UTILORANGE": TranslateColorName = 34
Case "DEEPORANGE": TranslateColorName = 52
Case "DKORANGE": TranslateColorName = 52
Case "PURPLE": TranslateColorName = 29
Case "DKPURPLE": TranslateColorName = 14
Case "LTPURPLE": TranslateColorName = 54
End Select
End Function


Hope it gets you started.
Sid