I'm sorry-little off subject-one question
How do you set the sheet Tab color on an excel sheet??
Thx in advance
I'm sorry-little off subject-one question
How do you set the sheet Tab color on an excel sheet??
Thx in advance
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