Option Explicit

Function sbGetCell(r As Range, s As String) As Variant
'Source (EN): http://www.sulprobil.de/sbgetcell_en/
'Source (DE): http://www.berndplumhoff.de/sbgetcell_de/
'Bernd Plumhoff V0.33 30-Oct-2022
With Application.WorksheetFunction
Application.Volatile
Select Case s
Case "AbsReference", "1"
    'Absolute style reference like $A$1
    If Application.Caller.Parent.Parent.Name = _
        r.Worksheet.Parent.Name And _
        Application.Caller.Parent.Name = r.Worksheet.Name Then
        sbGetCell = r.Address
    Else
        If InStr(r.Worksheet.Parent.Name & _
            r.Worksheet.Name, " ") > 0 Then
            sbGetCell = "'[" & r.Worksheet.Parent.Name & "]" & _
            r.Worksheet.Name & "'!" & r.Address
        Else
            sbGetCell = "[" & r.Worksheet.Parent.Name & "]" & _
            r.Worksheet.Name & "!" & r.Address
        End If
    End If
Case "RowNumber", "2"
    'Row number in the top cell reference
    sbGetCell = r.Row
Case "ColumnNumber", "3"
    'Column number of the leftmost cell in reference
    sbGetCell = r.Column
Case "Type", "4"
    'Same as TYPE(reference)
    sbGetCell = -IsEmpty(r) - .IsNumber(r) - .IsText(r) * 2 - .IsLogical(r) _
                * 4 - .IsError(r) * 16 - IsArray(r) * 64
Case "Contents", "5"
    'Contents of reference
    sbGetCell = r.Value
Case "FormulaLocal", "ShowFormula", "6"
    'Cell formula
    sbGetCell = r.FormulaLocal
Case "NumberFormat", "7"
    'Number format of cell
    sbGetCell = r.NumberFormatLocal
Case "HorizontalAlignment", "8"
    'Number indicating the cell's horizontal alignment
    Select Case r.HorizontalAlignment
    Case xlGeneral
        sbGetCell = 1
    Case xlLeft
        sbGetCell = 2
    Case xlCenter
        sbGetCell = 3
    Case xlRight
        sbGetCell = 4
    Case xlFill
        sbGetCell = 5
    Case xlJustify
        sbGetCell = 6
    Case xlCenterAcrossSelection
        sbGetCell = 7
    Case xlDistributed
        sbGetCell = 8
    Case Else
        Debug.Assert False 'Should not get here
    End Select
Case "LeftBorderStyle", "9"
    'Number indicating the left-border style assigned to the cell
    Select Case r.Borders(1).LineStyle
    Case xlLineStyleNone
        sbGetCell = 0
    Case xlHairline
        sbGetCell = IIf(r.Borders(1).Weight = xlMedium, 2, 7)
    Case xlDot
        sbGetCell = 4
    Case xlDashDotDot
        sbGetCell = IIf(r.Borders(1).Weight = xlMedium, 12, 11)
    Case xlDashDot
        sbGetCell = IIf(r.Borders(1).Weight = xlMedium, 10, 9)
    Case xlDash
        sbGetCell = IIf(r.Borders(1).Weight = xlMedium, 8, 3)
    Case xlSlantDashDot
        sbGetCell = 13
    Case xlDouble
        sbGetCell = 6
    Case Else
        sbGetCell = CVErr(xlErrValue)
    End Select
Case "RightBorderStyle", "10"
    'Number indicating the right-border style assigned to the cell
    Select Case r.Borders(2).LineStyle
    Case xlLineStyleNone
        sbGetCell = 0
    Case xlHairline
        sbGetCell = IIf(r.Borders(2).Weight = xlMedium, 2, 7)
    Case xlDot
        sbGetCell = 4
    Case xlDashDotDot
        sbGetCell = IIf(r.Borders(2).Weight = xlMedium, 12, 11)
    Case xlDashDot
        sbGetCell = IIf(r.Borders(2).Weight = xlMedium, 10, 9)
    Case xlDash
        sbGetCell = IIf(r.Borders(2).Weight = xlMedium, 8, 3)
    Case xlSlantDashDot
        sbGetCell = 13
    Case xlDouble
        sbGetCell = 6
    Case Else
        sbGetCell = CVErr(xlErrValue)
    End Select
Case "TopBorderStyle", "11"
    'Number indicating the top-border style assigned to the cell
    Select Case r.Borders(3).LineStyle
    Case xlLineStyleNone
        sbGetCell = 0
    Case xlHairline
        sbGetCell = IIf(r.Borders(3).Weight = xlMedium, 2, 7)
    Case xlDot
        sbGetCell = 4
    Case xlDashDotDot
        sbGetCell = IIf(r.Borders(3).Weight = xlMedium, 12, 11)
    Case xlDashDot
        sbGetCell = IIf(r.Borders(3).Weight = xlMedium, 10, 9)
    Case xlDash
        sbGetCell = IIf(r.Borders(3).Weight = xlMedium, 8, 3)
    Case xlSlantDashDot
        sbGetCell = 13
    Case xlDouble
        sbGetCell = 6
    Case Else
        sbGetCell = CVErr(xlErrValue)
    End Select
Case "BottomBorderStyle", "12"
    'Number indicating the bottom-border style assigned to the cell
    Select Case r.Borders(4).LineStyle
    Case xlLineStyleNone
        sbGetCell = 0
    Case xlHairline
        sbGetCell = IIf(r.Borders(4).Weight = xlMedium, 2, 7)
    Case xlDot
        sbGetCell = 4
    Case xlDashDotDot
        sbGetCell = IIf(r.Borders(4).Weight = xlMedium, 12, 11)
    Case xlDashDot
        sbGetCell = IIf(r.Borders(4).Weight = xlMedium, 10, 9)
    Case xlDash
        sbGetCell = IIf(r.Borders(4).Weight = xlMedium, 8, 3)
    Case xlSlantDashDot
        sbGetCell = 13
    Case xlDouble
        sbGetCell = 6
    Case Else
        sbGetCell = CVErr(xlErrValue)
    End Select
Case "Pattern", "13"
    'Number indicating cell pattern
    sbGetCell = r.Interior.Pattern
Case "IsLocked", "14"
    'True if cell is locked
    sbGetCell = r.Locked
Case "FormulaHidden", "HiddenFormula", "15"
    'True if cell formula is hidden
    sbGetCell = r.FormulaHidden
Case "Width", "CellWidth", "16"
    'Cell width. If array-entered into two cells of a row,
    'second value is true if width is standard
    sbGetCell = Array(r.ColumnWidth, r.UseStandardWidth) 'Not width!
Case "Height", "RowHeight", "17"
    'Cell height
    sbGetCell = r.RowHeight
Case "FontName", "18"
    'Cell font name
    sbGetCell = r.Font.Name
Case "FontSize", "19"
    'Cell font size
    sbGetCell = r.Font.Size
Case "IsBold", "20"
    'Cell is formatted bold?
    sbGetCell = r.Font.Bold
Case "IsItalic", "21"
    'Cell is formatted in Italics?
    sbGetCell = r.Font.Italic
Case "IsUnderlined", "22"
    'Cell is formatted as underlined?
    sbGetCell = (r.Font.Underline = xlUnderlineStyleSingle Or _
                 r.Font.Underline = xlUnderlineStyleSingleAccounting Or _
                 r.Font.Underline = xlUnderlineStyleDouble Or _
                 r.Font.Underline = xlUnderlineStyleDoubleAccounting)
Case "IsStruckThrough", "23"
    'Cell characters are struck through?
    sbGetCell = r.Font.Strikethrough
Case "FontColorIndex", "24"
    'Cell font color of first character, 1-56, 0 = automatic
    sbGetCell = r.Font.ColorIndex
Case "IsOutlined", "25", "IsShaddowed", "26"
    'Cell font is outlined or shaddowed? (Not supported by Excel)
    sbGetCell = False
Case "PageBreak", "27"
    '0 = no break, 1 = row, 2 = column, 3 = row and column
    sbGetCell = -(r.EntireRow.PageBreak <> xlPageBreakNone) - 2 * (r.EntireColumn.PageBreak <> xlPageBreakNone)
Case "RowLevelOutline", "28"
    'Row level outline
    sbGetCell = r.EntireRow.OutlineLevel
Case "ColumnLevelOutline", "29"
    'Row level outline
    sbGetCell = r.EntireColumn.OutlineLevel
Case "IsSummaryRow", "30"
    'Row is a summary row?
    sbGetCell = r.EntireRow.Summary
Case "IsSummaryColumn", "31"
    'Column is a summary column?
    sbGetCell = r.EntireColumn.Summary
Case "WorkbookSheetName", "32"
    'Workbook name like [Book1.xls]Sheet1 or Book1.xls if
    'workbook and single sheet have
    'identical names
    If r.Worksheet.Parent.Name = r.Worksheet.Name & ".xls" And _
        Application.Worksheets.Count = 1 Then
        sbGetCell = r.Worksheet.Parent.Name
    Else
        sbGetCell = "[" & r.Worksheet.Parent.Name & "]" & _
        r.Worksheet.Name
    End If
Case "IsWrapped", "33"
    'Cell text is formatted as wrapped?
    sbGetCell = r.WrapText
Case "LeftBorderColorIndex", "34"
    'Left border color index
    sbGetCell = r.Borders.Item(1).ColorIndex
Case "RightBorderColorIndex", "35"
    'Right border color index
    sbGetCell = r.Borders.Item(2).ColorIndex
Case "TopBorderColorIndex", "36"
    'Top border color index
    sbGetCell = r.Borders.Item(3).ColorIndex
Case "BottomBorderColorIndex", "37"
    'Bottom border color index
    sbGetCell = r.Borders.Item(4).ColorIndex
Case "ShadeForeGroundColor", "38", "PatternBackGroundColor", "64"
    'ShadeForeGroundColor
    sbGetCell = r.Interior.PatternColorIndex
Case "ShadeBackGroundColor", "39", "PatternForeGroundColor", "63"
    'ShadeBackGroundColor
    sbGetCell = r.Interior.ColorIndex
Case "TextStyle", "40"
    'Style of the cell, as text
    sbGetCell = r.Style.NameLocal
Case "FormulaWOT", "41"
    'Returns the formula in the active cell without translating it (useful for international macro sheets)
    sbGetCell = r.Formula
'Case "HDistWinToLCell", "42"
'    'Horizontal distance, measured in points, from the left edge of the active window to the left edge of the cell
'    sbGetCell = r. 'Does not work yet
Case "HasNote", "46"
    'True if cell contains a text note
    sbGetCell = Len(r.NoteText) > 0
Case "HasSound", "47"
    'True if cell has a sound note. Not supported.
    sbGetCell = False
Case "HasFormula", "48"
    'True if cell contains a formula
    sbGetCell = r.HasFormula
Case "IsArray", "49"
    'True if cell is part of an array formula
    sbGetCell = r.HasArray
Case "VerticalAlignment", "50"
    '1 = Top, 2 = Center, 3 = Bottom, 4 = Justified, 5 = Distributed
    sbGetCell = -(r.VerticalAlignment = xlVAlignTop) - 2 * (r.VerticalAlignment = xlVAlignCenter) - _
                3 * (r.VerticalAlignment = xlVAlignBottom) - 4 * (r.VerticalAlignment = xlVAlignJustify) - _
                5 * (r.VerticalAlignment = xlVAlignDistributed)
Case "VerticalOrientation", "51"
    '0 = Horizontal, 1 = Vertical, 2 = Upward, 3 = Downward
    sbGetCell = -(r.Orientation = xlVertical) - 2 * (r.Orientation = xlUpward) - _
                3 * (r.Orientation = xlDownward)
Case "IsStringConst", "IsStringConstant", "52"
    'Text alignment char "'" if cell is a string constant,
    'empty string "" if not
    sbGetCell = r.PrefixCharacter
Case "AsText", "53"
    'Cell displayed as text with numbers formatted and symbols included
    sbGetCell = r.Text
Case "PivotTableViewName", "54"
    'PivotTableViewName
    sbGetCell = r.PivotTable.Name
'Case "PivotTableViewPosition", "55"
'    'PivotTableViewPosition
'    sbGetCell = r.PivotField.Position 'Not correct yet
Case "PivotTableViewFieldName", "56"
    'PivotTableViewFieldName
    sbGetCell = r.PivotField.Name
Case "IsSuperscript", "57"
    'Cell text is formatted as superscript?
    sbGetCell = r.Font.Superscript
Case "FontStyleText", "58"
    'FontStyleText
    sbGetCell = r.Font.FontStyle
Case "UnderlineStyle", "59"
    'Underline style, 1 = none, 2 = single, 3 = double, 4 = single accounting, 5 = double accounting
    Select Case r.Font.Underline
    Case xlUnderlineStyleNone
        sbGetCell = 1
    Case xlUnderlineStyleSingle
        sbGetCell = 2
    Case xlUnderlineStyleDouble
        sbGetCell = 3
    Case xlUnderlineStyleSingleAccounting
        sbGetCell = 4
    Case xlUnderlineStyleDoubleAccounting
        sbGetCell = 5
    Case Else
        sbGetCell = CVErr(xlErrValue)
    End Select
Case "IsSubscript", "60"
    'Cell text is formatted as subscript?
    sbGetCell = r.Font.Subscript
Case "PivotTableItemName", "61"
    'PivotTableItemName
    sbGetCell = r.PivotItem.Name
Case "WorksheetName", "62"
    'Worksheet name like [Book1.xls]Sheet1
        sbGetCell = "[" & r.Worksheet.Parent.Name & "]" & _
                    r.Worksheet.Name
Case "IsAddIndentAlignment", "65"
    'Only Far East Excel Versions
    sbGetCell = False 'Not supported here
Case "WorkbookName", "66"
    'Workbook name like Book1.xls
    sbGetCell = r.Worksheet.Parent.Name
Case "IsHidden"
    'Cell hidden?
    sbGetCell = r.EntireRow.Hidden Or r.EntireColumn.Hidden
Case Else
    sbGetCell = CVErr(xlErrValue)
End Select
End With
End Function