IE 11 BB Code Tags

Code:
'   Convert Excel range to BBCode Table - Page 2
'   http://www.excelfox.com/forum/f13/bbcode-table-2077/
'   '//Original code is written by Rick Rothstein
    '//http://www.excelfox.com/forum/f22/get-displayed-cell-color-whether-from-conditional-formatting-or-not-338/
'   No User Form. Run Main Code  Sub BB_Table_Clipboard_PikeFoxAlan()
Option Explicit
' First Declaring Bit of my Code version of the code from Pike, Kris and Rick. http://www.excelfox.com/forum/f17/te...2079/#post9642
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Declare Function CloseClipboard Lib "User32" () As Long
Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
Declare Function EmptyClipboard Lib "User32" () As Long
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Const GHND = &H42
Private Const CF_TEXT = 1
Private Const MAXSIZE = 4096
'
'Main Code     http://www.excelfox.com/forum/f17/te...2079/#post9643
Sub BB_Table_Clipboard_PikeFoxAlan() 'http://www.excelfox.com/forum/f13/bbcode-table-2077/    Convert Excel range to BBCode Table - Page 2
     
    Dim BB_Row As Range, BB_Cells As Range, BB_Range As Range
    Dim BB_Code As String, strFontColour As String, strBackColour As String, strAlign As String, strWidth As String
    'Const csHEADER_COLOR As String = """#FFFFFF"""
    Const csHEADER_COLOR As String = "black"
    'Const csHEADER_BACK As String = "#888888"
    Const csHEADER_BACK As String = "powderblue"
    Const csROW_BACK As String = "#FFFFFF"
    Set BB_Range = Selection
    BB_Code = "Using " & ExcelVersion & "" & vbCrLf 'Give Excel version
    BB_Code = BB_Code & "[size=" & 0 & "]
v
[COLOR=" & csHEADER_COLOR & "]Row\Col[/COLOR]
" & Split(BB_Cells.Address, "$")(1) & "

[COLOR=" & csHEADER_COLOR & "]" & ColLtr(BB_Cells.Column) & "[/COLOR]




" & BB_Row.Row & "
" & BB_Row.Row & "
[COLOR=""" & strFontColour & """]" & IIf(BB_Cells.Font.Bold, "", "") & BB_Cells.Text & IIf(BB_Cells.Font.Bold, "", "") & "[/COLOR]




[/size]"
    'End of main table
    BB_Code = BB_Code & "
Sheet: " & BB_Range.Parent.Name & "




" 'The parent ( One up the OOP change ) of the selects range is used to get at the sheet name.
    ClipBoard_SetData (BB_Code)
    Set BB_Range = Nothing
End Sub
'
'Some required functions.    http://www.excelfox.com/forum/f17/te...2079/#post9644
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 Alan 2016 VBA Column Letter from Column Number. Explained.
' 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