test BB Code

[DocAElstein]

Some required Functions

Private Function objColour(strCell As String) As String
    objColour = "#" & Right(Right("000000" & Hex(strCell), 6), 2) & Mid(Right("000000" & Hex(strCell), 6), 3, 2) & Left(Right("000000" & Hex(strCell), 6), 2)
End Function
 
Private Function FontAlignment(ByVal objCell As Object) As String
    With objCell
        Select Case .HorizontalAlignment
        Case xlLeft
            FontAlignment = "LEFT"
        Case xlRight
            FontAlignment = "RIGHT"
        Case xlCenter
            FontAlignment = "CENTER"
        Case Else
            Select Case VarType(.Value2)
            Case 8
                FontAlignment = "LEFT"
            Case 10, 11
                FontAlignment = "CENTER"
            Case Else
                FontAlignment = "RIGHT"
            End Select
        End Select
    End With
End Function
 
Private Function ClipBoard_SetData(MyString As String)
    Dim hGlobalMemory As Long, lpGlobalMemory As Long
    Dim hClipMemory As Long, X As Long
    
    hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)
    lpGlobalMemory = GlobalLock(hGlobalMemory)
    lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)
    If GlobalUnlock(hGlobalMemory) <> 0 Then
        MsgBox "Could not unlock memory location. Copy aborted."
        GoTo OutOfHere2
    End If
    If OpenClipboard(0&) = 0 Then
        MsgBox "Could not open the Clipboard. Copy aborted."
        Exit Function
    End If
    X = EmptyClipboard()
    hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
OutOfHere2:
    If CloseClipboard() = 0 Then
        MsgBox "Could not close Clipboard."
    End If
End Function
 
Private Function DisplayedColor(Cell As Range, Optional CellInterior As Boolean = True, _
    Optional ReturnColorIndex As Long = True) As Long
    
    Dim X As Long, Test As Boolean, CurrentCell As String, dColor   As Variant
    Dim F   As String, R  As Range
    
     '//Original code is written by Rick Rothstein
     '//http://www.excelfox.com/forum/f22/get-displayed-cell-color-whether-from-conditional-formatting-or-not-338/
    
    If Cell.Count > 1 Then Err.Raise vbObjectError - 999, , "Only single cell references allowed for 1st argument."
    CurrentCell = ActiveCell.Address(0, 0)
    For X = 1 To Cell.FormatConditions.Count
        With Cell.FormatConditions(X)
            If .Type = xlCellValue Then
                Select Case .Operator
                Case xlBetween:      Test = Cell.Value >= Evaluate(.Formula1) And Cell.Value <= Evaluate(.Formula2)
                Case xlNotBetween:   Test = Cell.Value <= Evaluate(.Formula1) Or Cell.Value >= Evaluate(.Formula2)
                Case xlEqual:        Test = Evaluate(.Formula1) = Cell.Value
                Case xlNotEqual:     Test = Evaluate(.Formula1) <> Cell.Value
                Case xlGreater:      Test = Cell.Value > Evaluate(.Formula1)
                Case xlLess:         Test = Cell.Value < Evaluate(.Formula1)
                Case xlGreaterEqual: Test = Cell.Value >= Evaluate(.Formula1)
                Case xlLessEqual:    Test = Cell.Value <= Evaluate(.Formula1)
                End Select
            ElseIf .Type = xlExpression Then
                Application.ScreenUpdating = False
                 'Cell.Select
                F = Replace(.Formula1, "$", vbNullString)
                F = Replace(F, CurrentCell, Cell.Address(0, 0))
                 'Test = Evaluate(.Formula1)
                Test = Evaluate(F)
                 'Range(CurrentCell).Select
                Application.ScreenUpdating = True
            End If
            If Test Then
                If CellInterior Then
                    dColor = IIf(ReturnColorIndex, .Interior.ColorIndex, .Interior.Color)
                    If IsNull(dColor) Then
                        dColor = IIf(ReturnColorIndex, Cell.Interior.ColorIndex, Cell.Interior.Color)
                    End If
                Else
                    dColor = IIf(ReturnColorIndex, .Font.ColorIndex, .Font.Color)
                    If IsNull(dColor) Then
                        dColor = IIf(ReturnColorIndex, Cell.Font.ColorIndex, Cell.Font.Color)
                    End If
                End If
                DisplayedColor = dColor
                Exit Function
            End If
        End With
    Next
    If CellInterior Then
        dColor = IIf(ReturnColorIndex, Cell.Interior.ColorIndex, Cell.Interior.Color)
    Else
        dColor = IIf(ReturnColorIndex, Cell.Font.ColorIndex, Cell.Font.Color)
    End If
    DisplayedColor = dColor
    
End Function
'
Private Function ExcelVersion() As String
    Dim temp                  As String
 
    'On Error Resume Next
#If Mac Then
    Select Case Val(Application.Version)
        Case 11: temp = "Excel 2004"
        Case 12: temp = "Excel 2008" ' this should NEVER happen!
        Case 14: temp = "Excel 2011"
        Case 15: temp = "vNext"
        Case Else: temp = "Unknown"
    End Select
#Else
    Select Case Val(Application.Version)
        Case 9: temp = "Excel 2000"
        Case 10: temp = "Excel 2002"
        Case 11: temp = "Excel 2003"
        Case 12: temp = "Excel 2007"
        Case 14: temp = "Excel 2010"
        Case 15: temp = "Excel 2013"
        Case Else: temp = "Unknown"
    End Select
#End If
    ExcelVersion = temp
End Function
'
'
Private Function ColLtr(ByVal iCol As Long) As String
' shg 2012       http://www.excelfox.com/forum/f13/summary-of-maximum-rows-used-across-each-sheet-in-a-workbook-2053/#post9482
' Good for any positive Long
    If iCol > 0 Then
    ColLtr = ColLtr((iCol - 1) \ 26) & Chr(65 + (iCol - 1) Mod 26)
    Else
    End If
End Function