Page 2 of 7 FirstFirst 1234 ... LastLast
Results 11 to 20 of 62

Thread: BBCode Table

  1. #11
    Junior Member pike's Avatar
    Join Date
    Dec 2011
    Posts
    27
    Rep Power
    0
    Hi Doc,
    I don't totally understand the question and it maybe better to post it in the help forum .. basically the code is VBA not PHP or HTML code.
    Only post VBA with Code tags, PHP in the PHP tags and HTML code with HTML tags.
    You should post a question on what you want to achieve and not your anticipated solution.

  2. #12
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,270
    Rep Power
    10
    Hi Pike,

    Thanks for the reply,

    Quote Originally Posted by pike View Post
    Only post VBA with Code tags, PHP in the PHP tags and HTML code with HTML tags.
    As far as I know that is usually the case, correct. But An exception is the codes we are looking at here which contain strings to build up a BB Code. Those strings will often interfere and cause problems when pasted within BB Code Tags. Hence we usually paste those codes in PHP or HTML ( If you heck out your post #1, you will see that :::.....Last edited by Admin; 01-20-2016 at 04:51 AM. Reason: replaced code tag with php ... . )
    I just did another quick demo for you:
    First you see in BB Code Tags you get a problem:
    http://www.excelforum.com/showthread...t=#post4376284
    http://www.excelfox.com/forum/f17/te....html#post9720

    Then the same in HTML Code Tags it is usually OK
    http://www.excelforum.com/showthread...t=#post4376285
    http://www.excelfox.com/forum/f17/te....html#post9718
    and PHP Tags are also usually OK
    http://www.excelfox.com/forum/f17/te....html#post9719
    http://www.excelforum.com/showthread.php?t=1057943&page=13&p=4376284&highlight=#post4376326


    Occaisionally, in some forums, some browsers etc. etc. you get the problem i was on about ....
    http://www.excelfox.com/forum/f17/te...2079/#post9634
    But I note that this Problem is appearing less and less. An update to the Forum Software may have had some effect
    _....._________________________


    Quote Originally Posted by pike View Post
    I don't totally understand ...….
    You should post a question on what you want to achieve and not your anticipated solution….

    I posted a small follow up question some time back, as there were problems with carriage returns vanishing sometimes when trying to copy and share the code further in the HTML Code tags. I had no answer.

    I then found a couple of solutions to that problem myself so shared those.

    So no Problem, Or rather I have given a couple of solution to a problem that can occur. ( Some people experienced the problem, contacted me and I sent them here to get the solution. In addition at another Forum they did something in their software to prevent the problem coming up ) - If you get the problem ever, then you can refer back to my detailed solutions, or let me know if you need better explanation. There were two general solutions, as I detailed in the previous post and in the referred to posts.
    _..............


    maybe better to post it in the help forum .


    I think that would confuse the issue . The question and solution are directly related to using and, in particular sharing this code, so probably better to be tacked on here as I did. I realise that there should be no questions asked in this Sub Forum. But in this case I thought it was appropriate. .......... particularly as I gave then the solution.....
    Anyone wanting the code will probably go straight to the first few posts here to get what they want. Then if they do experience the problems I detailed, then theymay come back here and they may see my reference to those problems and the given solutions. I do not think there is an "About the Board" Type Sub Forum here at ExcelFox. TheHelp Forums are for Excel Word, etc....

    _..........................

    Quote Originally Posted by pike View Post
    I don't totally understand


    I do not want to labor the point again as I have tried to explain it in detail. But very briefly.


    _1) For these particular type of VBA Codes you do need to use HTML or PHP Code Tags when Posting them


    _2) When you copy such a code into such Tags and post, you can sometimes get strange results as I indicated with carriage returns vanishing. I gave a couple of solutions to get over that.


    Hope that clears it up a bit. Thanks for popping in here…. BTW.**
    Alan
    _..............................................

    P.s. BTW**… How are you accessing ExcelFox just Now. Using Google Chrome I get blocked and am given a warning of a viruses , similar to those which plagued ExcelForum a few Months back. I would be carefuls how you access ExcelFox just now. I drop my Email to you per PM now as I am a bit nervous to use the Forum just now. I have informed Admin and Rick ( Rothstein )
    _..
    This is what I get when trying to Access ExcelFox using Google Chrome

    :

    For further examples see Links in first post here





    http://www.excelforum.com/the-water-...e-or-back.html
    Last edited by DocAElstein; 05-01-2016 at 05:52 PM.

  3. #13
    Junior Member pike's Avatar
    Join Date
    Dec 2011
    Posts
    27
    Rep Power
    0
    Hello,
    The PHP code is executed by the Web server when a web page is accessed and the resulting output is written as HTML within the Web page.

    I just tried different PHPBB table properties to find which ones also worked with BBcode as the is little written about all there methods and properties.

    Your question is about excel cell string which split string with carriage return[s] and converting to BBcode via VBA.

    BBCode or Bulletin Board Code is a basic markup language used to format posts boards which is complied by HTML to covert to a basic table ect...

    The VBA BBcode generator does not account for carriage returns in a cell .. work around .. .do not use carriage return and then size the columns and rows height and width to the desired look. Converting excel cell height and width to BBcode table (Height and Width) is a best fit as different fonts have different character heights and widths. basic algorithm for fifteen or so character (few Spaces) is RoundUp(BB_Cells.ColumnWidth * 7.5, 0) you will never get an exact conversion match. It is linear but also needs a count of different character sizes. a x potential algorithm could be better guess for 15 to 25 chars

    Code:
     Set BB_Range = Selection
        BB_Code = "[table=" & """" & "class:thin_grid" & """" & "]" & vbNewLine
        BB_Code = BB_Code & "[tr][td][font=Wingdings]v[/font][/td]" & vbNewLine
        For Each BB_Cells In BB_Range.Rows(1).Cells
            strWidth = Application.WorksheetFunction.RoundUp(BB_Cells.ColumnWidth * 7.5, 0)
            BB_Code = BB_Code & "[td=" & """" & "bgcolor:#ECF0F0, align:center,width:" & strWidth & """" & "][B]" & Split(BB_Cells.Address, "$")(1) & "[/B][/td]" & vbNewLine
        Next BB_Cells
        BB_Code = BB_Code & "[/tr]"
    Also not all excel font styles are available in BBcode so I never tried added them into the routine .. but you could do it and if the font is not available use a default. you will notice in the code above the Windings font does not always get complied from a v to an asterisk

    It just a basic table and never a complete worksheet representation , if you have more a complex work upload a workbook.

    hope that helps
    Last edited by pike; 05-04-2016 at 12:20 PM.

  4. #14
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,270
    Rep Power
    10

    Trying to Explain to Pike about Posting BB Code Genarator VBA Codes in Forum Posts

    Hi Pike,
    I really do appreciate you taking the time to reply and give all of that info. It sounds very intersting. Thanks . Sadly , I am a computer novice, and do not really understand. I get only the general point. It certainly sounds like the code snippet you gave could come in handy to further improve your great BB Code Genarator Code. Sadly I lack the ability to incorporate that in your code. I lack the basic understanding. I do not really understand what you are talking about.......
    Quote Originally Posted by pike View Post
    .......
    Your question is about excel cell string which split string with carriage return[s] and converting to BBcode via VBA.
    ......
    ...... No That was not anything like my question ( i think ). You have given some fantasic answers but have completely missed my point. Sorry if i have explained so badly.....
    I try again:
    I did some more tests for you, just now to try to get accross what I am talking about. Once again: It is all to do with how to share your code in a Forum - that is to say what Code Tags to use. Your BB Code Genarator Code is a VBA Code, so normally we would use the normal BB Code Tags ( from icon # above ).....
    But....
    Quote Originally Posted by DocAElstein View Post
    ..........
    ......But An exception .... codes ... which contain strings to build up a BB Code. Those strings will often interfere and cause problems when pasted within BB Code Tags. Hence we usually paste those codes in PHP or HTML ( If you check out your post #1, you will see that :::.....Last edited by Admin; 01-20-2016 at 04:51 AM. Reason: replaced code tag with php ... . )
    I just did another quick demo for you:
    First you see in BB Code Tags you get a problem:
    Excel Help Forum
    http://www.excelfox.com/forum/f17/te....html#post9720

    Then the same in HTML Code Tags it is usually OK
    Excel Help Forum
    http://www.excelfox.com/forum/f17/te....html#post9718
    and PHP Tags are also usually OK
    http://www.excelfox.com/forum/f17/te....html#post9719
    http://www.excelforum.com/showthread.php?t=1057943&page=13&p=4376284&highlight=#post4376326



    Occaisionally, in some forums, some browsers etc. etc. you get the problem I was on about ....
    http://www.excelfox.com/forum/f17/te...2079/#post9634
    But I note that this Problem is appearing less and less. An update to the Forum Software may have had some effect
    _....._________________________

    Basically the point is this:

    -1) Your BB Code Genarator Code which is the point of this Thread ( and which is a VBA Code ) , will **usually not come out properly in a BB Code Window. So we use a HTML or PHP Code Window as an exception for this type of VBA Code, - that is to say a VBA Code where there are strings inside it with BB Code bits in it ( the square bracket stuff)
    (_.. -2) Very occaisionally, ( and not often anymore ), there were also some additional problems when using a HTML window to post your BB Code Genarator Code. I gave a couple of work arounds to that. (Note that this post is from a few Month's ago and there were some updates in Forum Software in the maentime, effecting Code Windows, such as the scroll bar which suddenly appeared in many Forums that did not have it:
    http://www.excelfox.com/forum/f17/code-tag-test-with-long-comments-1976/#post9664
    from Post # 50 http://www.mrexcel.com/forum/about-b...sh-list-5.html
    _.....)

    What you are talkng about does sound very interseting and useful. But it is something completely different. ( i think )

    If you check out those tests I just did for you, then I think it should be obvious what I was getting at...
    I am so very greatful that you take the time to give me such great ( unfortunately above my head partly ) info. So sorry it is not relavent to what I was trying to get across. Hope those extra tests will help.

    Alan

    _.........
    **P.s. I note that in some of your referrences, for example
    Convert Excel range to BBCode Table - Page 2
    then in the code window you are using there, "VB:" , you do not experience the problems that I have been referring to. But as I have endeavoured to explain, you will get problems at MrExcel, ExcelFox, and ExcelForum if you attempt to post your VBA BBcode generator in normal BB Code Tags. It would appear that at Ozgrid your "normal" Code Window is different to that at MrExcel ExcelForum and ExcelFox. I have no account at, or experience with, Ozgrid Forum

    _.....

    P.P.s
    Since the last time we spoke last January generally about BB Code Generators, the Theme came up a bit in some Threads.. may be just of passing interest...
    How to post a range - headers and data? [SOLVED] - Page 17
    Tags for Coloring Table cells for EXCELFORUM [SOLVED]
    I updated the File I gave you, to include some of the new Codes presented.
    https://app.box.com/s/zhz7awdag4nl1zs6564s9zzcwp50e4w9

    Last edited by DocAElstein; 05-01-2016 at 08:33 PM.

  5. #15
    Junior Member pike's Avatar
    Join Date
    Dec 2011
    Posts
    27
    Rep Power
    0
    I have posted the table on all the above forum with no problems.. attach the workbook with the offending strings

  6. #16
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,270
    Rep Power
    10
    I think I am going mad...
    Quote Originally Posted by pike View Post
    I have posted the table on all the above forum with no problems.. attach the workbook with the offending strings
    It has nothing to do with Tables. A Workbook can be no help what so ever here.
    Maybe you have not had time to read all the last few Posts I did for you?

    Once again. I am talking about posting your code, ( or similar codes which within the code lines have BB Code Strings in them ) into a Forum Post.


    I will repeat again what I have done for you all over the place in the links I gave in the last few posts above:
    I will take a version of your code.
    In the next post I will paste it in normal Code Tags.
    Then in the Post after that I will post it again in HTML Code Tags
    Then in the Post after that I will post it again in php Code Tags
    These experiments i have done already for you in different Forums as linked in my las few replies

    If you look carefully at the resulting codes you will see I think that in the Normal Code Tags there is some rubish in because the parts of the code with BB Code Tags strings in have interfered badly.

    In the HTML and php Code windows the codes look fine.

    The same I have found in other Forums. As I also mentioned it appears your normal code Tags are different at Ozgrid. You appear to not have this problem there. I cannot check that.

    So .. experiments once again in next posts


    EDIT And just for fun I dropped in a last one showing the other problem that only occasionally happens which is when carriage returns get lost

    Maybe strangely you do not get the problem??
    Why not try copying your code to the clipboard
    Then paste it here in normal code Tags and see how it looks
    Last edited by DocAElstein; 05-02-2016 at 02:18 PM.

  7. #17
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,270
    Rep Power
    10
    Normal Code Tags

    Code:
    '   http://www.ozgrid.com/forum/showthread.php?t=198172&page=2&p=763613#post763613'   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/test-bb-code-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/test-bb-code-2079/#post9643
    Sub BB_Table_Clipboard_PikeFoxAlan() 'http://www.excelfox.com/forum/f13/bbcode-table-2077/    http://www.ozgrid.com/forum/showthread.php?t=198172&page=2&p=763613#post763613
         
        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/test-bb-code-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 http://www.excelforum.com/tips-and-tutorials/1108643-vba-column-letter-from-column-number-explained.html ' 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

  8. #18
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,270
    Rep Power
    10
    HTML Code Tags

    HTML Code:
    Option ExplicitDeclare 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 
    Public Const GHND = &H42 
    Public Const CF_TEXT = 1 
    Public Const MAXSIZE = 4096 
     
    Sub BB_Table_Clipboard() 
         
        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 
         
        Set BB_Range = Selection 
        BB_Code = "[table=" & """" & "class:thin_grid" & """" & "]" & vbNewLine 
        BB_Code = BB_Code & "[tr][td][font=Wingdings]v[/font][/td]" & vbNewLine 
        For Each BB_Cells In BB_Range.Rows(1).Cells 
            strWidth = Application.WorksheetFunction.RoundUp(BB_Cells.ColumnWidth * 7.5, 0) 
            BB_Code = BB_Code & "[td=" & """" & "bgcolor:#ECF0F0, align:center, width:" & strWidth & """" & "][B]" & Split(BB_Cells.Address, "$")(1) & "[/B][/td]" & vbNewLine 
        Next BB_Cells 
        BB_Code = BB_Code & "[/tr]" 
        For Each BB_Row In BB_Range.Rows 
            BB_Code = BB_Code & "[tr]" 
            BB_Code = BB_Code & "[td=" & """" & "bgcolor:#ECF0F0, align:center" & """" & "][B]" & BB_Row.Row & "[/B][/td]" & vbNewLine 
            For Each BB_Cells In BB_Row.Cells 
                If BB_Cells.FormatConditions.Count Then 
                    strFontColour = objColour(DisplayedColor(BB_Cells, False, False)) 
                    strBackColour = objColour(DisplayedColor(BB_Cells, True, False)) 
                Else 
                    strFontColour = objColour(BB_Cells.Font.Color) 
                    strBackColour = objColour(BB_Cells.Interior.Color) 
                End If 
                strAlign = FontAlignment(BB_Cells) 
                BB_Code = BB_Code & "[td=" & """" & "bgcolor:" & strBackColour & ", align:" & strAlign & """" & "][COLOR=""" & strFontColour & """]" & IIf(BB_Cells.Font.Bold, "[B]", "") & BB_Cells.Text & IIf(BB_Cells.Font.Bold, "[/B]", "") & "[/COLOR][/td]" & vbNewLine 
            Next BB_Cells 
            BB_Code = BB_Code & "[/tr]" & vbNewLine 
        Next BB_Row 
        BB_Code = BB_Code & "[/table]" 
        ClipBoard_SetData (BB_Code) 
        Set BB_Range = Nothing 
    End Sub 
     
    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 
     
    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 
     
    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 
     
    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

  9. #19
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,270
    Rep Power
    10
    PHP Code:
    Option ExplicitDeclare 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 LongByVal 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 AnyByVal lpString2 As Any) As Long 
    Declare Function SetClipboardData Lib "User32" (ByVal wFormat As LongByVal hMem As Long) As Long 
    Public Const GHND = &H42 
    Public Const CF_TEXT 
    Public Const MAXSIZE 4096 
     
    Sub BB_Table_Clipboard
    () 
         
        
    Dim BB_Row As RangeBB_Cells As RangeBB_Range As Range 
        Dim BB_Code 
    As StringstrFontColour As StringstrBackColour As StringstrAlign As StringstrWidth As String 
         
        Set BB_Range 
    Selection 
        BB_Code 
    "[table=" """" "class:thin_grid" """" "]" vbNewLine 
        BB_Code 
    BB_Code "[tr][td][font=Wingdings]v[/font][/td]" vbNewLine 
        
    For Each BB_Cells In BB_Range.Rows(1).Cells 
            strWidth 
    Application.WorksheetFunction.RoundUp(BB_Cells.ColumnWidth 7.50
            
    BB_Code BB_Code "[td=" """" "bgcolor:#ECF0F0, align:center, width:" strWidth """" "][B]" Split(BB_Cells.Address"$")(1) & "[/B][/td]" vbNewLine 
        Next BB_Cells 
        BB_Code 
    BB_Code "[/tr]" 
        
    For Each BB_Row In BB_Range.Rows 
            BB_Code 
    BB_Code "[tr]" 
            
    BB_Code BB_Code "[td=" """" "bgcolor:#ECF0F0, align:center" """" "][B]" BB_Row.Row "[/B][/td]" vbNewLine 
            
    For Each BB_Cells In BB_Row.Cells 
                
    If BB_Cells.FormatConditions.Count Then 
                    strFontColour 
    objColour(DisplayedColor(BB_CellsFalseFalse)) 
                    
    strBackColour objColour(DisplayedColor(BB_CellsTrueFalse)) 
                Else 
                    
    strFontColour objColour(BB_Cells.Font.Color
                    
    strBackColour objColour(BB_Cells.Interior.Color
                
    End If 
                
    strAlign FontAlignment(BB_Cells
                
    BB_Code BB_Code "[td=" """" "bgcolor:" strBackColour ", align:" strAlign """" "][COLOR=""" strFontColour """]" IIf(BB_Cells.Font.Bold"[B]""") & BB_Cells.Text IIf(BB_Cells.Font.Bold"[/B]""") & "[/COLOR][/td]" vbNewLine 
            Next BB_Cells 
            BB_Code 
    BB_Code "[/tr]" vbNewLine 
        Next BB_Row 
        BB_Code 
    BB_Code "[/table]" 
        
    ClipBoard_SetData (BB_Code
        
    Set BB_Range Nothing 
    End Sub 
     
    Function objColour(strCell As String) As String 
        objColour 
    "#" Right(Right("000000" Hex(strCell), 6), 2) & Mid(Right("000000" Hex(strCell), 6), 32) & Left(Right("000000" Hex(strCell), 6), 2
    End Function 
     
    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 

                    FontAlignment 
    "LEFT" 
                
    Case 1011 
                    FontAlignment 
    "CENTER" 
                
    Case Else 
                    
    FontAlignment "RIGHT" 
                
    End Select 
            End Select 
        End With 
    End 
    Function 
     
    Function 
    ClipBoard_SetData(MyString As String
        
    Dim hGlobalMemory As LonglpGlobalMemory As Long 
        Dim hClipMemory 
    As LongAs Long 
         
        hGlobalMemory 
    GlobalAlloc(GHNDLen(MyString) + 1
        
    lpGlobalMemory GlobalLock(hGlobalMemory
        
    lpGlobalMemory lstrcpy(lpGlobalMemoryMyString
        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 
        
    EmptyClipboard() 
        
    hClipMemory SetClipboardData(CF_TEXThGlobalMemory
    OutOfHere2
        If 
    CloseClipboard() = 0 Then 
            MsgBox 
    "Could not close Clipboard." 
        
    End If 
    End Function 
     
    Function 
    DisplayedColor(Cell As RangeOptional CellInterior As Boolean True
        Optional ReturnColorIndex 
    As Long True) As Long 
         
        Dim X 
    As LongTest As BooleanCurrentCell As StringdColor   As Variant 
        Dim F   
    As StringR  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(00
        For 
    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 
    xlGreaterEqualTest 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 

  10. #20
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,270
    Rep Power
    10
    And just for fun the other problem that occaisionally occurs.. the loss of carriage returns

    HTML Code:
    '   http://www.ozgrid.com/forum/showthread.php?t=198172&page=2&p=763613#post763613'   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/test-bb-code-2079/#post9642Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As LongDeclare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As LongDeclare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As LongDeclare Function CloseClipboard Lib "User32" () As LongDeclare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As LongDeclare Function EmptyClipboard Lib "User32" () As LongDeclare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongDeclare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As LongPrivate Const GHND = &H42Private Const CF_TEXT = 1Private Const MAXSIZE = 4096''Main Code     http://www.excelfox.com/forum/f17/test-bb-code-2079/#post9643Sub BB_Table_Clipboard_PikeFoxAlan() 'http://www.excelfox.com/forum/f13/bbcode-table-2077/    http://www.ozgrid.com/forum/showthread.php?t=198172&page=2&p=763613#post763613         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 = "[color=lightgrey]Using " & ExcelVersion & "[/color]" & vbCrLf 'Give Excel version    BB_Code = BB_Code & "[size=" & 0 & "][table=" & """" & "class:thin_grid" & """" & "]" & vbNewLine    'BB_Code = BB_Code & "[tr][td][font=Wingdings]v[/font][/td]" & vbNewLine    BB_Code = BB_Code & "[tr=bgcolor:" & csHEADER_BACK & "][th][COLOR=" & csHEADER_COLOR & "][sub]Row[/sub]\[sup]Col[/sup][/COLOR][/th]"      ' top left cell    For Each BB_Cells In BB_Range.Rows(1).Cells 'Column Letters        strWidth = Application.WorksheetFunction.RoundUp(BB_Cells.ColumnWidth * 7.5, 0)        'BB_Code = BB_Code & "[td=" & """" & "bgcolor:#ECF0F0, align:center, width:" & strWidth & """" & "][B]" & Split(BB_Cells.Address, "$")(1) & "[/B][/td]" & vbNewLine        BB_Code = BB_Code & "[th][CENTER][COLOR=" & csHEADER_COLOR & "]" & ColLtr(BB_Cells.Column) & "[/COLOR][/CENTER][/th]" 'Column Letter Row    Next BB_Cells    BB_Code = BB_Code & "[/tr]"    For Each BB_Row In BB_Range.Rows 'Row Numbers        BB_Code = BB_Code & "[tr]"        'BB_Code = BB_Code & "[td=" & """" & "bgcolor:#ECF0F0, align:center" & """" & "][B]" & BB_Row.Row & "[/B][/td]" & vbNewLine        BB_Code = BB_Code & "[td=" & """" & "bgcolor:" & csHEADER_BACK & ", align:center" & """" & "][B]" & BB_Row.Row & "[/B][/td]" & vbNewLine        For Each BB_Cells In BB_Row.Cells            If BB_Cells.FormatConditions.Count Then                strFontColour = objColour(DisplayedColor(BB_Cells, False, False))                strBackColour = objColour(DisplayedColor(BB_Cells, True, False))            Else                strFontColour = objColour(BB_Cells.Font.Color)                strBackColour = objColour(BB_Cells.Interior.Color)            End If            strAlign = FontAlignment(BB_Cells)            BB_Code = BB_Code & "[td=" & """" & "bgcolor:" & strBackColour & ", align:" & strAlign & """" & "][COLOR=""" & strFontColour & """]" & IIf(BB_Cells.Font.Bold, "[B]", "") & BB_Cells.Text & IIf(BB_Cells.Font.Bold, "[/B]", "") & "[/COLOR][/td]" & vbNewLine        Next BB_Cells        BB_Code = BB_Code & "[/tr]" & vbNewLine    Next BB_Row    BB_Code = BB_Code & "[/table][/size]"    'End of main table    BB_Code = BB_Code & "[Table=""width:, class:grid""][tr][td]Sheet: [b]" & BB_Range.Parent.Name & "[/b][/td][/tr][/table]" '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 = NothingEnd Sub''Some required functions.    http://www.excelfox.com/forum/f17/test-bb-code-2079/#post9644Private 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 WithEnd 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 IfEnd 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 = tempEnd Function''Private Function ColLtr(ByVal iCol As Long) As String' shg 2012 Alan 2016 http://www.excelforum.com/tips-and-tutorials/1108643-vba-column-letter-from-column-number-explained.html' Good for any positive Long    If iCol > 0 Then    ColLtr = ColLtr((iCol - 1) \ 26) & Chr(65 + (iCol - 1) Mod 26)    Else    End IfEnd Function

Similar Threads

  1. test bbcode
    By pike in forum Test Area
    Replies: 3
    Last Post: 05-16-2016, 03:58 AM
  2. Excluding Records of one Table from the Other Table
    By Transformer in forum Tips, Tricks & Downloads (No Questions)
    Replies: 0
    Last Post: 05-17-2013, 12:32 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •