Sleeper: TAB color revisited

[clvestin]

I'm sorry-little off subject-one question

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

[Cyberdude]

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