You are on the Home/Excel/VBA/Decode Mnemonics page
Google
Web This Site

Decode Mnemonics (Names of constants)

There are several reasons why one might want to know what the value of a property represents.  The reason could be a simple one of preparing up-to-date documentation.  Or, it could be what I consider one of the more important techniques for understanding and exploring objects encountered while developing software -- what I call bootstrapping.

One needs to know how to interpret the values returned by some property.  Unfortunately, there is a disconnect between the documentation and the values returned.  The documentation uses named constants of some type.  The returned values are numbers!  And, there is no easy way to connect one to the other.  A simple example will make this crystal clear.  Each sheet in an Excel workbook has a Visible property.  The documentation indicates that it can be either XlSheetVisible, XlSheetHidden, or XlSheetVeryHidden.  But if one tests the property of a sheet, one will get a number such as -1, 0, or 2.  Now, if one wants to prepare a report (say for a compliance audit) of all the sheets in a workbook and the visible state, one needs to do a fair amount of work relating the numbers to the names (or mnemonics).  The easiest way to do this would be through a simple function that has nothing but a Case statement.  Something like

Option Explicit
Function decodeSheetVisibility(x) As String
    Select Case x
    Case xlSheetHidden: decodeSheetVisibility = "xlSheetHidden"
    Case xlSheetVisible: decodeSheetVisibility = "xlSheetVisible"
    Case xlSheetVeryHidden: decodeSheetVisibility = "xlSheetVeryHidden"
    Case Else: decodeSheetVisibility = _
            "Unrecognized argument value in decodeSheetVisibility (" & x & ")"
        End Select
    End Function
Example 1

Of course, this is for a single property with just three possible values.  Imagine doing this for something the ChartType property, which has over 70 possible values!

The solution I use is a macro that creates the decode___ subroutine!  It takes a range of cells and for each value in that range it adds an additional Case clause.  For example, to create the above decodeSheetVisibility procedure, I copied the contents of the help for xlSheetVisibility into a worksheet range G1:G3

and then ran a one line procedure

Sub createDecodeSheetVisibility()
    createMnemonicDecoder "decodeSheetVisibility", _
        Range("G1:G3")
    End Sub

Executing the createMnemonicDecoder subroutine with the appropriate arguments created the decodeSheetVisibility procedure above.  The code for the createMnemonicDecoder is below.  Note that it needs a reference to the Microsoft Visual Basic for Applications Extensibility 5.3 library.

Sub createMnemonicDecoder(FunctionName As String, aRng As Range, _
        Optional ConstantType As String)
    Dim aModule As VBComponent, aStr As String, aCell As Range
    Set aModule = ActiveWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule)
    aStr = "function " & FunctionName & "(x" _
        & IIf(ConstantType = "", "", " as " & ConstantType) _
        & ") as string" & vbNewLine _
        & vbTab & "select case x" & vbNewLine
    For Each aCell In aRng.Cells
        aStr = aStr & vbTab & "case " & aCell.Value & ":" _
            & FunctionName & "=""" & aCell.Value & """" & vbNewLine
        Next aCell
    aStr = aStr & vbTab & "Case Else:" _
        & FunctionName & "= _" & vbNewLine _
        & String(3, vbTab) & """Unrecognized argument value in " _
        & FunctionName & " ("" & x & "")""" & vbNewLine
    aStr = aStr & vbTab & vbTab & "end select" & vbNewLine _
        & vbTab & "end function"
    aModule.CodeModule.AddFromString aStr
    End Sub
Note that the code is intended for the intermediate to advanced developer and contains no safety checks.  It is up to you to use it correctly.  At the very least, provide a legitimate function name (decodeSheetVisibility in the above example) and a range that contains the correct mnemonics (constant names).  Also, please make sure that the security settings allow the code to add a new code module to the active workbook's VBProject.  And, don't forget the reference to the Microsoft Visual Basic for Applications Extensibility 5.3 library.  Finally, if you use the optional ConstantType argument, it must be the correct name.

Remember the 70+ values for the ChartType property of the Chart object?  I copied the list from the help into an empty worksheet:

xlLine  Line
xlLineMarkersStacked  Stacked Line with Markers
xlLineStacked  Stacked Line
xlPie  Pie
xlPieOfPie  Pie of Pie
xlPyramidBarStacked  Stacked Pyramid Bar
xlPyramidCol  3D Pyramid Column
xlPyramidColClustered  Clustered Pyramid Column
xlPyramidColStacked  Stacked Pyramid Column
xlPyramidColStacked100  100% Stacked Pyramid Column
xlRadar  Radar
xlRadarFilled  Filled Radar
xlRadarMarkers  Radar with Data Markers
xlStockHLC  High-Low-Close
xlStockOHLC  Open-High-Low-Close
xlStockVHLC  Volume-High-Low-Close
xlStockVOHLC  Volume-Open-High-Low-Close
xlSurface  3D Surface
xlSurfaceTopView  Surface (Top View)
xlSurfaceTopViewWireframe  Surface (Top View wireframe)
xlSurfaceWireframe  3D Surface (wireframe)
xlXYScatter  Scatter
xlXYScatterLines  Scatter with Lines
xlXYScatterLinesNoMarkers  Scatter with Lines and No Data Markers
xlXYScatterSmooth  Scatter with Smoothed Lines
xlXYScatterSmoothNoMarkers  Scatter with Smoothed Lines and No Data Markers
xl3DArea  3D Area
xl3DAreaStacked  3D Stacked Area
xl3DAreaStacked100  100% Stacked Area
xl3DBarClustered  3D Clustered Bar
xl3DBarStacked  3D Stacked Bar
xl3DBarStacked100  3D 100% Stacked Bar
xl3DColumn  3D Column
xl3DColumnClustered  3D Clustered Column
xl3DColumnStacked  3D Stacked Column
xl3DColumnStacked100  3D 100% Stacked Column
xl3DLine  3D Line
xl3DPie  3D Pie
xl3DPieExploded  Exploded 3D Pie
xlArea  Area
xlAreaStacked  Stacked Area
xlAreaStacked100  100% Stacked Area
xlBarClustered  Clustered Bar
xlBarOfPie  Bar of Pie
xlBarStacked  Stacked Bar
xlBarStacked100  100% Stacked Bar
xlBubble  Bubble
xlBubble3DEffect  Bubble with 3D effects
xlColumnClustered  Clustered Column
xlColumnStacked  Stacked Column
xlColumnStacked100  100% Stacked Column
xlConeBarClustered  Clustered Cone Bar
xlConeBarStacked  Stacked Cone Bar
xlConeBarStacked100  100% Stacked Cone Bar
xlConeCol  3D Cone Column
xlConeColClustered  Clustered Cone Column
xlConeColStacked  Stacked Cone Column
xlConeColStacked100  100% Stacked Cone Column
xlCylinderBarClustered  Clustered Cylinder Bar
xlCylinderBarStacked  Stacked Cylinder Bar
xlCylinderBarStacked100  100% Stacked Cylinder Bar
xlCylinderCol  3D Cylinder Column
xlCylinderColClustered  Clustered Cone Column
xlCylinderColStacked  Stacked Cone Column
xlCylinderColStacked100  100% Stacked Cylinder Column
xlDoughnut  Doughnut
xlDoughnutExploded  Exploded Doughnut
xlLineMarkers  Line with Markers
xlLineMarkersStacked100  100% Stacked Line with Markers
xlLineStacked100  100% Stacked Line
xlPieExploded  Exploded Pie
xlPyramidBarClustered  Clustered Pyramid Bar
xlPyramidBarStacked100  100% Stacked Pyramid Bar

and ran the one line procedure:

Sub createDecodeChartType()
    createMnemonicDecoder "decodeChartType", _
        Selection.CurrentRegion.Columns(1), "xlcharttype"
    End Sub

to generate the procedure below:

Option Explicit
Function decodeChartType(x As XlChartType) As String
    Select Case x
    Case xlLine: decodeChartType = "xlLine"
    Case xlLineMarkersStacked: decodeChartType = "xlLineMarkersStacked"
    Case xlLineStacked: decodeChartType = "xlLineStacked"
    Case xlPie: decodeChartType = "xlPie"
    Case xlPieOfPie: decodeChartType = "xlPieOfPie"
    Case xlPyramidBarStacked: decodeChartType = "xlPyramidBarStacked"
    Case xlPyramidCol: decodeChartType = "xlPyramidCol"
    Case xlPyramidColClustered: decodeChartType = "xlPyramidColClustered"
    Case xlPyramidColStacked: decodeChartType = "xlPyramidColStacked"
    Case xlPyramidColStacked100: decodeChartType = "xlPyramidColStacked100"
    Case xlRadar: decodeChartType = "xlRadar"
    Case xlRadarFilled: decodeChartType = "xlRadarFilled"
    Case xlRadarMarkers: decodeChartType = "xlRadarMarkers"
    Case xlStockHLC: decodeChartType = "xlStockHLC"
    Case xlStockOHLC: decodeChartType = "xlStockOHLC"
    Case xlStockVHLC: decodeChartType = "xlStockVHLC"
    Case xlStockVOHLC: decodeChartType = "xlStockVOHLC"
    Case xlSurface: decodeChartType = "xlSurface"
    Case xlSurfaceTopView: decodeChartType = "xlSurfaceTopView"
    Case xlSurfaceTopViewWireframe: decodeChartType = "xlSurfaceTopViewWireframe"
    Case xlSurfaceWireframe: decodeChartType = "xlSurfaceWireframe"
    Case xlXYScatter: decodeChartType = "xlXYScatter"
    Case xlXYScatterLines: decodeChartType = "xlXYScatterLines"
    Case xlXYScatterLinesNoMarkers: decodeChartType = "xlXYScatterLinesNoMarkers"
    Case xlXYScatterSmooth: decodeChartType = "xlXYScatterSmooth"
    Case xlXYScatterSmoothNoMarkers: decodeChartType = "xlXYScatterSmoothNoMarkers"
    Case xl3DArea: decodeChartType = "xl3DArea"
    Case xl3DAreaStacked: decodeChartType = "xl3DAreaStacked"
    Case xl3DAreaStacked100: decodeChartType = "xl3DAreaStacked100"
    Case xl3DBarClustered: decodeChartType = "xl3DBarClustered"
    Case xl3DBarStacked: decodeChartType = "xl3DBarStacked"
    Case xl3DBarStacked100: decodeChartType = "xl3DBarStacked100"
    Case xl3DColumn: decodeChartType = "xl3DColumn"
    Case xl3DColumnClustered: decodeChartType = "xl3DColumnClustered"
    Case xl3DColumnStacked: decodeChartType = "xl3DColumnStacked"
    Case xl3DColumnStacked100: decodeChartType = "xl3DColumnStacked100"
    Case xl3DLine: decodeChartType = "xl3DLine"
    Case xl3DPie: decodeChartType = "xl3DPie"
    Case xl3DPieExploded: decodeChartType = "xl3DPieExploded"
    Case xlArea: decodeChartType = "xlArea"
    Case xlAreaStacked: decodeChartType = "xlAreaStacked"
    Case xlAreaStacked100: decodeChartType = "xlAreaStacked100"
    Case xlBarClustered: decodeChartType = "xlBarClustered"
    Case xlBarOfPie: decodeChartType = "xlBarOfPie"
    Case xlBarStacked: decodeChartType = "xlBarStacked"
    Case xlBarStacked100: decodeChartType = "xlBarStacked100"
    Case xlBubble: decodeChartType = "xlBubble"
    Case xlBubble3DEffect: decodeChartType = "xlBubble3DEffect"
    Case xlColumnClustered: decodeChartType = "xlColumnClustered"
    Case xlColumnStacked: decodeChartType = "xlColumnStacked"
    Case xlColumnStacked100: decodeChartType = "xlColumnStacked100"
    Case xlConeBarClustered: decodeChartType = "xlConeBarClustered"
    Case xlConeBarStacked: decodeChartType = "xlConeBarStacked"
    Case xlConeBarStacked100: decodeChartType = "xlConeBarStacked100"
    Case xlConeCol: decodeChartType = "xlConeCol"
    Case xlConeColClustered: decodeChartType = "xlConeColClustered"
    Case xlConeColStacked: decodeChartType = "xlConeColStacked"
    Case xlConeColStacked100: decodeChartType = "xlConeColStacked100"
    Case xlCylinderBarClustered: decodeChartType = "xlCylinderBarClustered"
    Case xlCylinderBarStacked: decodeChartType = "xlCylinderBarStacked"
    Case xlCylinderBarStacked100: decodeChartType = "xlCylinderBarStacked100"
    Case xlCylinderCol: decodeChartType = "xlCylinderCol"
    Case xlCylinderColClustered: decodeChartType = "xlCylinderColClustered"
    Case xlCylinderColStacked: decodeChartType = "xlCylinderColStacked"
    Case xlCylinderColStacked100: decodeChartType = "xlCylinderColStacked100"
    Case xlDoughnut: decodeChartType = "xlDoughnut"
    Case xlDoughnutExploded: decodeChartType = "xlDoughnutExploded"
    Case xlLineMarkers: decodeChartType = "xlLineMarkers"
    Case xlLineMarkersStacked100: decodeChartType = "xlLineMarkersStacked100"
    Case xlLineStacked100: decodeChartType = "xlLineStacked100"
    Case xlPieExploded: decodeChartType = "xlPieExploded"
    Case xlPyramidBarClustered: decodeChartType = "xlPyramidBarClustered"
    Case xlPyramidBarStacked100: decodeChartType = "xlPyramidBarStacked100"
    Case Else: decodeChartType = _
            "Unrecognized argument value in decodeChartType (" & x & ")"
        End Select
    End Function