If you have any problems with this web page, please first read my browser notesbrowser notes [link to ../../Miscellany/Browsers/Browsers.php] and if you still have issues, feel free to e-mail mee-mail me [link to e-mail the author at mailto:Tony@WordArticles.com]

Querying colour properties

Querying

Building Code to Query Color Properties in Word 2007

If you have come here from the main article on colours, you will have seen how some colours, font colours for example, are represented in Word 2007, and not, perhaps, have been ready to make the leap straight to the code presented there; this page is for you and it explains in some detail what the code does and how it can be built. This is not a VBA tutorial and a basic knowledge of VBA is assumed, but I have tried to describe the process step by easy step; I just hope I haven’t made it too pedestrian in the process. If you have come here from somewhere else, the background to this is presented in the main article and, unless you are familiar with colours in Word 2007, you are recommended to familiarise yourself with the early part of the article before reading further here.

Making a start

When setting Color properties you could use the macro recorder to get a start, but when you use the facilities of the Word UI simply to query something, you are not taking any recordable action so you are on your own. Although querying a colour value is, in some ways, a more complex operation than setting one, you can still use the knowledge you gained when setting the properties to provide a starting point. You know that Theme colours, when encoded in a Color property always begin with 0xD, so a check for this would let you know whether or not you had one.

As an example this time, instead of a font colour, you can use the background colour of a table cell so the first thing to do is add a small table to a document, place your cursor somewhere inside it, and run this code:

Sub Colours2()

    If Left$(Hex$(Selection.Cells(1).Shading.BackgroundPatternColor), 1) = "D" Then
        MsgBox "The background of the cell is set to a Theme colour"
    Else
        MsgBox "The background of the cell is not a Theme colour"
    End If
    
End Sub

All this does is tell you, via a message box, whether or not you have a Theme-coloured background to the cell the cursor is in. You won't have one unless you have a default Table Style that includes themed colours and you have placed your cursor in a coloured cell, but it doesn't matter at this stage.

Before amending the code further, the first thing to do is add some names so that it doesn't become littered with rather meaningless literals

Sub Colours2()

    Const ColourTypeTheme   As String = "D"

    Dim ColourToTest        As Long
    Dim ColourToTestHex     As String
    
    ColourToTest = Selection.Cells(1).Shading.BackgroundPatternColor
    ColourToTestHex = Hex$(ColourToTest)
    
    If Left$(ColourToTestHex, 1) = ColourTypeTheme Then
        MsgBox "The background of the cell is set to a Theme colour"
    Else
        MsgBox "The background of the cell is not a Theme colour"
    End If
    
End Sub

This version uses one work variable for a copy of the Color property you are checking, and one for the string representation of its hexadecimal value. It also uses a constant for the 0xD value it is checking for. Actually, as you can see, the constant is a string, “D”, rather than a numeric 0xD. Although it will make no immediate practical difference, it is, really, more correct to work with the numeric values and a small amendment now will facilitate a further change later on:

Sub Colours2()

    Const ColourTypeTheme   As Byte = &HD

    Dim ColourToTest        As Long
    Dim ColourToTestHex     As String
    Dim ColourTypeByte      As Byte
    
    ColourToTest = Selection.Cells(1).Shading.BackgroundPatternColor
    ColourToTestHex = Hex$(ColourToTest)
    ColourTypeByte = CByte("&H" & Left$(ColourToTestHex, 1))
    
    If ColourTypeByte = ColourTypeTheme Then
        MsgBox "The background of the cell is set to a Theme colour"
    Else
        MsgBox "The background of the cell is not a Theme colour"
    End If
    
End Sub

One thing, perhaps obvious when pointed out, but still worthy of note, is that you should know that there are other ways in which you could extract a single byte from a Long variable, but none of them are entirely straightforward and the way I have chosen to do it here is as good as any and, I hope, reasonably understandable.

Checking for different colour types

Your chosen cell in your default table probably had an automatic colour, which for a table cell means it has no shading, that it is see-through, assuming it also has no Texture anyway. To change the code to also check for this, which, you’ll remember is coded as a value beginning 0xFF, means adding another constant and expanding the conditional logic that produces the message box. Try doing this, in which I have chosen to use a Case construct for the expanded condition:

Sub Colours2()

    Const ColourTypeTheme       As Byte = &HD
    Const ColourTypeAutomatic   As Byte = &HFF
    Dim ColourToTest            As Long
    Dim ColourToTestHex         As String
    Dim ColourTypeByte          As Byte
    
    ColourToTest = Selection.Cells(1).Shading.BackgroundPatternColor
    ColourToTestHex = Hex$(ColourToTest)
    ColourTypeByte = CByte("&H" & Left$(ColourToTestHex, 1))
    
    Select Case ColourTypeByte
        Case ColourTypeTheme
            MsgBox "The background of the cell is set to a Theme colour"
        Case ColourTypeAutomatic
            MsgBox "The background of the cell is set to Automatic (None)"
        Case Else
            MsgBox "The background of the cell is not a Theme, or automatic, colour"
    End Select

End Sub

If you do have an automatic cell background and you run this code you might expect to see a message telling you so. You won't see it. The reason is that the code converts the first, and only the first, hexadecimal character (representing half a byte) into the ColourTypeByte variable but it then checks for a value of 0xFF and, so, never finds a match. You have a problem: in the one case you want to check a single character (half a byte) and in the other, two characters (a whole byte). One way of satisfying these conflicting demands (there are, of course, several ways but if you read my page you get to do it my way) is to check for a range of values: instead of checking for 0xD, check for the range, 0xD0 through 0xDF. Then you can always use the first two hexadecimal characters:

Sub Colours2()

    Const ColourTypeThemeLow    As Byte = &HD0
    Const ColourTypeThemeHigh   As Byte = &HDF
    Const ColourTypeAutomatic   As Byte = &HFF
    Dim ColourToTest            As Long
    Dim ColourToTestHex         As String
    Dim ColourTypeByte          As Byte
    
    ColourToTest = Selection.Cells(1).Shading.BackgroundPatternColor
    ColourToTestHex = Hex$(ColourToTest)
    ColourTypeByte = CByte("&H" & Left$(ColourToTestHex, 2)) ' <=== Note the change here
    
    Select Case ColourTypeByte
        Case ColourTypeThemeLow To ColourTypeThemeHigh
            MsgBox "The background of the cell is set to a Theme colour"
        Case ColourTypeAutomatic
            MsgBox "The background of the cell is set to Automatic (None)"
        Case Else
            MsgBox "The background of the cell is not a Theme, or automatic, colour"
    End Select

End Sub

You now have code that will check the first byte of any Long value. Well, yes and no. Change the shading on the cell your cursor is in to red. I'd like to say that the easiest way is via the Shading button on the Ribbon but it is, perhaps, a 50-50 shot that you have the Table Tools > Design contextual tab displayed, so use whatever method you prefer. Red is the second colour from the left on the row labeled “Standard Colors”. When you have changed the colour, run the code again; it will tell you that the background is Automatic. The reason for this is that the Long value for Red is 0x000000FF and, as with other numbers, leading zeroes are normally suppressed so the code is checking the first two significant characters of the hex value ("FF"), rather than the actual first two characters ("00").

One way to ensure that you get the correct value is to put back the zeroes that have been suppressed. There are no built-in formatting facilities for hexadecimal numbers so you must code your own. I usually do this by prependiing the maximum possible number of suppressed zeroes (in this case, seven) and then taking the rightmost, in this case, eight characters of the resulting string, thus dropping off any excess zeroes I may have added.

Sub Colours2()

    Const ColourTypeThemeLow    As Byte = &HD0
    Const ColourTypeThemeHigh   As Byte = &HDF
    Const ColourTypeAutomatic   As Byte = &HFF
    Dim ColourToTest            As Long
    Dim ColourToTestHex         As String
    Dim ColourTypeByte          As Byte
    
    ColourToTest = Selection.Cells(1).Shading.BackgroundPatternColor
    ColourToTestHex = Right$(String$(7, "0") & Hex$(ColourToTest), 8)
    ColourTypeByte = CByte("&H" & Left$(ColourToTestHex, 2))
    
    Select Case ColourTypeByte
        Case ColourTypeThemeLow To ColourTypeThemeHigh
            MsgBox "The background of the cell is set to a Theme colour"
        Case ColourTypeAutomatic
            MsgBox "The background of the cell is set to Automatic (None)"
        Case Else
            MsgBox "The background of the cell is not a Theme, or automatic, colour"
    End Select

End Sub

You now do have code that will check the first byte of any Long value and can easily add to it to cater for all the possible codes for different types of colour references. You should note that not all types of colour are valid in all circumstances, for example table cell backgrounds can’t have system colours applied to them (try it and you'll get an “internal error”), but this code can be used in other circumstances and cell backgrounds are merely exemplary.

Sub Colours2()

    Const ColourTypeRGB         As Byte = &H0
    Const ColourTypeSystem      As Byte = &H80
    Const ColourTypeThemeLow    As Byte = &HD0
    Const ColourTypeThemeHigh   As Byte = &HDF
    Const ColourTypeAutomatic   As Byte = &HFF
    Dim ColourToTest            As Long
    Dim ColourToTestHex         As String
    Dim ColourTypeByte          As Byte
    
    ColourToTest = Selection.Cells(1).Shading.BackgroundPatternColor
    ColourToTestHex = Right$(String$(7, "0") & Hex$(ColourToTest), 8)
    ColourTypeByte = CByte("&H" & Left$(ColourToTestHex, 2))
    
    Select Case ColourTypeByte
        Case ColourTypeRGB
            MsgBox "The background of the cell is a standard RGB value"
        Case ColourTypeSystem
            MsgBox "The background of the cell is set to a Windows system colour"
        Case ColourTypeThemeLow To ColourTypeThemeHigh
            MsgBox "The background of the cell is set to a Theme colour"
        Case ColourTypeAutomatic
            MsgBox "The background of the cell is set to Automatic (None)"
        Case Else
            MsgBox "The background of the cell is not in a recognised format"
    End Select

End Sub

Making a Function of it

Now you have the basic structure of the code you need it would be good to separate the logic from the input and output data. You can do this by making it into a Function that takes the Long colour value as input and returns, at the moment, a text message. A Function is, in effect, incomplete without a calling piece of code, so this change also creates a Subroutine, which supplies the Color property for the function to translate and then displays the returned text:

Sub Colours2()
    MsgBox QueryColour(Selection.Cells(1).Shading.BackgroundPatternColor)
End Sub
 
Function QueryColour(ColourToTest As Long) _ As String
    Const ColourTypeRGB         As Byte = &H0
    Const ColourTypeSystem      As Byte = &H80
    Const ColourTypeThemeLow    As Byte = &HD0
    Const ColourTypeThemeHigh   As Byte = &HDF
    Const ColourTypeAutomatic   As Byte = &HFF

    ' Dim ColourToTest            As Long ' To be removed
    Dim ColourToTestHex         As String
    Dim ColourTypeByte          As Byte
    
    ' ColourToTest = Selection.Cells(1).Shading.BackgroundPatternColor ' To be removed
    ColourToTestHex = Right$(String$(7, "0") & Hex$(ColourToTest), 8)
    ColourTypeByte = CByte("&H" & Left$(ColourToTestHex, 2))
    
    Select Case ColourTypeByte
        Case ColourTypeRGB
            QueryColour = "The background of the cell is a standard RGB value"
        Case ColourTypeSystem
            QueryColour = "The background of the cell is set to a Windows system colour"
        Case ColourTypeThemeLow To ColourTypeThemeHigh
            QueryColour = "The background of the cell is set to a Theme colour"
        Case ColourTypeAutomatic
            QueryColour = "The background of the cell is set to Automatic"
        Case Else
            QueryColour = "The background of the cell is not in a recognised format"
    End Select
    
End Function

A text message is all very well in the simple demonstration scenario here but, in real life, information more easily queryable in code is much more useful. One way to supply such information is to return some kind of indicator, a numeric value, perhaps, from which the calling routine can decide whether or not it wants to issue a message. All this is really doing at the moment is moving some logic from the called to the calling procedure; it means changing the type of value returned, and passing back appropriate values, something like this ...

Sub Colours2()

    Select Case QueryColour(Selection.Cells(1).Shading.BackgroundPatternColor)

        Case ColourTypeRGB
            MsgBox "The background of the cell is a standard RGB value"
        Case ColourTypeAutomatic
            MsgBox "The background of the cell is set to Automatic"
        Case ColourTypeSystem
            MsgBox "The background of the cell is set to a Windows system colour"
        Case ColourTypeThemeLow
            MsgBox "The background of the cell is set to a Theme colour"
        Case Else
            MsgBox "The background of the cell is not in a recognised format"
    End Select
    
End Sub
 
Function QueryColour(ColourToTest As Long) _ As Byte Const ColourTypeRGB As Byte = &H0 Const ColourTypeAutomatic As Byte = &HFF Const ColourTypeSystem As Byte = &H80 Const ColourTypeThemeLow As Byte = &HD0 Const ColourTypeThemeHigh As Byte = &HDF Dim ColourToTestHex As String Dim ColourTypeByte As Byte ColourToTestHex = Right$(String$(7, "0") & Hex$(ColourToTest), 8) ColourTypeByte = CByte("&H" & Left$(ColourToTestHex, 2)) Select Case ColourTypeByte Case ColourTypeRGB QueryColour = ColourTypeRGB Case ColourTypeAutomatic QueryColour = ColourTypeAutomatic Case ColourTypeSystem QueryColour = ColourTypeSystem Case ColourTypeThemeLow To ColourTypeThemeHigh QueryColour = ColourTypeThemeLow Case Else QueryColour = ColourTypeByte End Select End Function

If you try and run this version of the Colours2 code, one of two things will happen. Either it will display a Message Box saying that the colour is in an unrecognised format or, if you have Option Explicit set, it will give a compiler error because variable ColourTypeRGB is not defined. If you are familiar with Option Explicit you can skip the next paragraph; if not, please read on.

Option Explicit is an option you can use to tell the VBA compiler that all variables must be declared; it is turned off by default but almost all VBA programmers will say that it should always be on. It operates at the module level and you turn it on by coding Option Explicit at the start of the module. You can make the VBE automatically add it to every new module (but not already existing ones) by going to Tools > Options... > Editor tab, and checking the box labeled “Require Variable Declaration”.

Back with the failing code, the underlying reason for the failure, if you haven’t already worked it out, is that the constants that I have started to use in the Colours2 routine are defined in the QueryColour routine and their scope (the other code that can see them) is limited to that routine. To be available in the Colours2 routine they must either be (re-)declared there or, better, declared once somewhere where they will be in scope in both routines; that somewhere is in the module, but outside any individual procedure.

Option Explicit

Const ColourTypeRGB         As Byte = &H0
Const ColourTypeAutomatic   As Byte = &HFF
Const ColourTypeSystem      As Byte = &H80
Const ColourTypeThemeLow    As Byte = &HD0
Const ColourTypeThemeHigh   As Byte = &HDF
 
' (Calling Colours2 routine unchanged)
Function QueryColour(ColourToTest As Long) _ As Byte
    Dim ColourToTestHex     As String
    Dim ColourTypeByte      As Byte

    ' Constants removed from here

    ColourToTestHex = Right$(String$(7, "0") & Hex$(ColourToTest), 8)
    ColourTypeByte = CByte("&H" & Left$(ColourToTestHex, 2))
    
    Select Case ColourTypeByte

        Case ColourTypeRGB
            QueryColour = ColourTypeRGB
        Case ColourTypeAutomatic
            QueryColour = ColourTypeAutomatic
        Case ColourTypeSystem
            QueryColour = ColourTypeSystem
        Case ColourTypeThemeLow To ColourTypeThemeHigh
            QueryColour = ColourTypeThemeLow
        Case Else
            QueryColour = ColourTypeByte

    End Select
    
End Function

Now that you have something that works, you can look at it and see the changes, the obvious one being the return of a byte from the function. This byte contains an arbitrary, and essentially meaningless, number from 0 to 255. The actual values you are using, however, do have meaning to you – and you have already given them names. The names are the names of the constants, now at module level. You cannot actually constrain the values but you can make them slightly more obvious and make it less likely that you, or anyone who comes after you, makes a mistake. You do this by using an Enumeration. Often misunderstood, an Enumeration is simply a grouping of numeric constants that can be used as a special type of variable; the variable itself will be a Long number but the Intellisense in the VBE will prompt with the list of names from the enumeration. You already have the constants; incorporating them into an Enumeration and then using it is simplicity itself ....

Option Explicit

Enum ColourType
    ColourTypeRGB        = &H0
    ColourTypeAutomatic  = &HFF
    ColourTypeSystem     = &H80
    ColourTypeThemeLow   = &HD0
    ColourTypeThemeHigh  = &HDF
End Enum
 
' (Calling Colours2 routine unchanged)
Function QueryColour(ColourToTest As Long) _ As ColourType
    Dim ColourToTestHex  As String
    Dim ColourTypeByte   As Byte

    ColourToTestHex = Right$(String$(7, "0") & Hex$(ColourToTest), 8)
    ColourTypeByte = CByte("&H" & Left$(ColourToTestHex, 2))
    
    Select Case ColourTypeByte

        Case ColourTypeRGB
            QueryColour = ColourTypeRGB
        Case ColourTypeAutomatic
            QueryColour = ColourTypeAutomatic
        Case ColourTypeSystem
            QueryColour = ColourTypeSystem
        Case ColourTypeThemeLow To ColourTypeThemeHigh
            QueryColour = ColourTypeThemeLow
        Case Else
            QueryColour = ColourTypeByte

    End Select
    
End Function

Extracting the Theme Details

You could be forgiven for thinking that you’ve done a lot and achieved very little. All you have is a function that strips a byte from a Long value and returns it as another Long value for the caller to interpret. What can I say, except that it is but a first step? When you have a structure to work within, and know what type of colour you have, you can start to further interpret the coded information. As you saw earlier, with Theme colours, the index identifying the particular colour is in the same byte as the the 0xD identifying it, and any tinting or shading is encoded in the two least significant bytes of the Long value. If you are unsure of the details, check back to see how the code to set Theme colourscode to set Theme colours [link to 2007BuildSet.php] was built; the (new) code here is just a reverse of the code to set the colour.

Option Explicit

Enum ColourType
    ColourTypeRGB        = &H0
    ColourTypeAutomatic  = &HFF
    ColourTypeSystem     = &H80
    ColourTypeThemeLow   = &HD0
    ColourTypeThemeHigh  = &HDF
End Enum
 
' (Calling Colours2 routine still unchanged)
Function QueryColour(ColourToTest As Long) _ As ColourType
    Const Unchanged      As Byte = &HFF

    Dim ColourToTestHex  As String
    Dim ColourTypeByte   As Byte

    Dim ThemeColorIndex  As wdThemeColorIndex
    Dim TintAndShade     As Double

    Dim LightnessByte    As Byte
    Dim DarknessByte     As Byte

    ColourToTestHex = Right$(String$(7, "0") & Hex$(ColourToTest), 8)
    ColourTypeByte = CByte("&H" & Left$(ColourToTestHex, 2))
    
    Select Case ColourTypeByte

        Case ColourTypeRGB
            QueryColour = ColourTypeRGB

        Case ColourTypeAutomatic
            QueryColour = ColourTypeAutomatic

        Case ColourTypeSystem
            QueryColour = ColourTypeSystem

        Case ColourTypeThemeLow To ColourTypeThemeHigh
            QueryColour = ColourTypeThemeLow

            ThemeColorIndex = ColourTypeByte And &HF

            DarknessByte = CByte("&H" & Mid$(ColourToTestHex, 5, 2))
            LightnessByte = CByte("&H" & Mid$(ColourToTestHex, 7, 2))

            If DarknessByte <> Unchanged Then 
                TintAndShade = Round(-1 + DarknessByte / &HFF, 2)
            End If
            If LightnessByte <> Unchanged Then 
                TintAndShade = Round(1 - LightnessByte / &HFF, 2) 
            End if

        Case Else
            QueryColour = ColourTypeByte

    End Select
    
End Function

Now you have a lot more information, but you haven’t passed it back to the caller; it will just be discarded when the Function ends. The return data, the data type of the Function, is ColourType, or Long. If you try and devise a way of encoding the extra information into a single Long number, you haven’t really achieved much so you need a mechanism for passing back more than just the colour type. You do this by defining a data structure, or User Defined Type. You define Types at the start of the module, before any procedures. In this case, one of your data items is a ColourType enumeration and, for VBA to understand it, the Type definition must follow the ColourType definition (VBA reads top to bottom, just like you).

Once you have defined your Type, you use it by defining variables as being of the Type (here called ColourDetails) and, using the dot operator, you can address each individual element within the structure. Changing the return type of the Function allows you to place the data there instead of in useless variables within the Function, and, when there, the caller can use them, here simply reporting them via the message box already in use.

Option Explicit

Enum ColourType
    ColourTypeRGB        = &H0
    ColourTypeAutomatic  = &HFF
    ColourTypeSystem     = &H80
    ColourTypeThemeLow   = &HD0
    ColourTypeThemeHigh  = &HDF
End Enum
Type ColourDetails
    ColourType      As ColourType
    ThemeColorIndex As WdThemeColorIndex
    TintAndShade    As Double
End Type
 
Sub Colours2() With QueryColour(Selection.Cells(1).Shading.BackgroundPatternColor) Select Case .ColourType Case ColourTypeRGB MsgBox "The background of the cell is a standard RGB value" Case ColourTypeAutomatic MsgBox "The background of the cell is set to Automatic" Case ColourTypeSystem MsgBox "The background of the cell is set to a Windows system colour" Case ColourTypeThemeLow MsgBox "The background of the cell is set to Theme colour " & _ .ThemeColorIndex & ", with tinting or shading " & .TintAndShade Case Else MsgBox "The background of the cell is not in a recognised format" End Select End With End Sub
Function QueryColour(ColourToTest As Long) _ As ColourDetails Const Unchanged As Byte = &HFF Dim ColourToTestHex As String Dim ColourTypeByte As Byte ' Dim ThemeColorIndex As wdThemeColorIndex ' No longer needed ' Dim TintAndShade As Double ' No longer needed Dim LightnessByte As Byte Dim DarknessByte As Byte ColourToTestHex = Right$(String$(7, "0") & Hex$(ColourToTest), 8) ColourTypeByte = CByte("&H" & Left$(ColourToTestHex, 2)) Select Case ColourTypeByte Case ColourTypeRGB QueryColour.ColourType = ColourTypeRGB Case ColourTypeAutomatic QueryColour.ColourType = ColourTypeAutomatic Case ColourTypeSystem QueryColour.ColourType = ColourTypeSystem Case ColourTypeThemeLow To ColourTypeThemeHigh QueryColour.ColourType = ColourTypeThemeLow QueryColour.ThemeColorIndex = ColourTypeByte And &HF DarknessByte = CByte("&H" & Mid$(ColourToTestHex, 5, 2)) LightnessByte = CByte("&H" & Mid$(ColourToTestHex, 7, 2)) If DarknessByte <> Unchanged Then QueryColour.TintAndShade = Round(-1 + DarknessByte / &HFF, 2) End If If LightnessByte <> Unchanged Then QueryColour.TintAndShade = Round(1 - LightnessByte / &HFF, 2) End if Case Else QueryColour.ColourType = ColourTypeByte End Select End Function

I use a couple of rules of thumb when I design programs: procedures should have a single (simple) purpose, and not be longer than a single printed page. I know this is a hangover from a long-gone past, and I rarely print code any more, but I still think it acts a good guideline. Here, the QueryColour function is, firstly, determining the type of colour encoded and, secondly, extracting Theme-specific colour information. Eventually it will have to extract colour information of other types, and will start to break both my rules of thumb. Pre-empting that, I am going to split it into two now, while it's easy, rather than later.

The new (subordinate) function will provide the data to populate the data structure to be passed back to the original caller so it may as well populate the structure directly; its return type will, therefore, be ColourDetails. To extract the data, the new routine requires details of the Color property, which you have already converted to an easily-queryable string representation of its hex value, and the ColourToTestHex string is the obvious value to pass to it.

' (Module-level definitions as before)
 
' (Calling Colours2 routine as before)
Function QueryColour(ColourToTest As Long) _ As ColourDetails
    Dim ColourToTestHex  As String
    Dim ColourTypeByte   As Byte

    ColourToTestHex = Right$(String$(7, "0") & Hex$(ColourToTest), 8)
    ColourTypeByte = CByte("&H" & Left$(ColourToTestHex, 2))
    
    Select Case ColourTypeByte

        Case ColourTypeRGB
            QueryColour.ColourType = ColourTypeRGB

        Case ColourTypeAutomatic
            QueryColour.ColourType = ColourTypeAutomatic

        Case ColourTypeSystem
            QueryColour.ColourType = ColourTypeSystem

        Case ColourTypeThemeLow To ColourTypeThemeHigh
            QueryColour = QueryThemeColor(ColourToTestHex)

        Case Else
            QueryColour.ColourType = ColourTypeByte

    End Select
    
End Function
 
Function QueryThemeColor(ColourToTestHex As String) _ As ColourDetails Const Unchanged As Byte = &HFF Dim ColourTypeByte As Byte Dim LightnessByte As Byte Dim DarknessByte As Byte ColourTypeByte = CByte("&H" & Left$(ColourToTestHex, 2)) LightnessByte = CByte("&H" & Mid$(ColourToTestHex, 7, 2)) DarknessByte = CByte("&H" & Mid$(ColourToTestHex, 5, 2)) QueryThemeColor.ColourType = ColourTypeByte And &HF0 QueryThemeColor.ThemeColorIndex = ColourTypeByte And &HF If DarknessByte <> Unchanged Then QueryThemeColor.TintAndShade = Round(-1 + DarknessByte / &HFF, 2) End If If LightnessByte <> Unchanged Then QueryThemeColor.TintAndShade = Round(1 - LightnessByte / &HFF, 2) End If End Function

You may note that you are duplicating some code. Both functions extract the ColourTypeByte from the hex string; this is because both functions need the information, for slightly different purposes. You could arrange the code in a different way to avoid this but there wouldn't be a significant advantage and I prefer to do it as shown for what I consider more clarity.

You will almost certainly note that, although you are now passing back more details, you are not yet doing anything with the extra information; the calling Colours2 subroutine is simply echoing the numeric data it's being given; whilst this may not be entirely useless, there is much more that can be done. The discussion here, however, has been quite lengthy enough, and you are encouraged to return to the main articlereturn to the main article [link to Querying, in the main article at 2007.php#QueryingColoursII], where you can discover some more of the mysteries of themes, and from where there are links to separate pages detailing different ways of using the returned data.