Todd Chambery

Rem  *****  BASIC  *****
Sub TiddlyWikiExport()

    ' Dimension all variables
    Dim TableData As String
    Dim ColumnCount As Integer
    Dim RowCount As Integer
    Dim ClipboardData As New DataObject

    ' Loop for each row in selection
    For RowCount = 1 To Selection.Rows.Count

        ' Write the initial table tag
        TableData = TableData & "|"

        ' Loop for each column in selection
        For ColumnCount = 1 To Selection.Columns.Count

        ' Do header formatting for the first row
        If RowCount = 1 Then
            TableData = TableData & "!"
        Else

            ' Write the background color tag
            If Selection.Cells(RowCount, ColumnCount).Interior.Color <> vbWhite Then
                ColorToRGB CStr(Selection.Cells(RowCount, ColumnCount).Interior.Color), r, g, b
                TableData = TableData & "bgcolor(#" & r & g & b & "): "
            End If

            ' Write the initial bold tag
            If Selection.Cells(RowCount, ColumnCount).Font.Bold = True Then
                TableData = TableData & "''"
            End If

            ' Write the initial italics tag
            If Selection.Cells(RowCount, ColumnCount).Font.Italic = True Then
                TableData = TableData & "//"
            End If

            ' Write the initial strikethrough tag
            If Selection.Cells(RowCount, ColumnCount).Font.Strikethrough = True Then
                TableData = TableData & "---"
            End If

            ' Set right alignment
            If Selection.Cells(RowCount, ColumnCount).HorizontalAlignment = xlRight Or _
                Selection.Cells(RowCount, ColumnCount).HorizontalAlignment = xlCenter Then
                TableData = TableData & " "
            End If

            ' Write the initial font color tag
            If Selection.Cells(RowCount, ColumnCount).Font.Color <> vbBlack Then
                ColorToRGB CStr(Selection.Cells(RowCount, ColumnCount).Font.Color), r, g, b
                TableData = TableData & "@@color(#" & r & g & b & "):"
            End If

            ' Write the initial hyperlink tag
            If Selection.Cells(RowCount, ColumnCount).Hyperlinks.Count > 0 Then
                TableData = TableData & "[["
            End If
        End If

        ' Write current cell's text
        content = Replace(Selection.Cells(RowCount, ColumnCount).Text, Chr$(10), "<br>")
        TableData = TableData & content

        If RowCount <> 1 Then

           ' Write the initial hyperlink tag
           If Selection.Cells(RowCount, ColumnCount).Hyperlinks.Count > 0 Then
               TableData = TableData & "|" & Selection.Cells(RowCount, ColumnCount).Hyperlinks(1).Address & "]]"
           End If

           ' Write the ending font color tag
           If Selection.Cells(RowCount, ColumnCount).Font.Color <> vbBlack Then
               TableData = TableData & "@@"
           End If


           ' Set left alignment
           If Selection.Cells(RowCount, ColumnCount).HorizontalAlignment = xlLeft Or _
               Selection.Cells(RowCount, ColumnCount).HorizontalAlignment = xlCenter Then
               TableData = TableData & " "
           End If

           ' Write the ending strikethrough tag
           If Selection.Cells(RowCount, ColumnCount).Font.Strikethrough = True Then
               TableData = TableData & "---"
           End If

           ' Write the ending italic tag
           If Selection.Cells(RowCount, ColumnCount).Font.Italic = True Then
               TableData = TableData & "//"
           End If

           ' Write the ending bold tag
           If Selection.Cells(RowCount, ColumnCount).Font.Bold = True Then
               TableData = TableData & "''"
           End If
        End If

        ' Write the ending table separator
        TableData = TableData & "|"

        ' Check if cell is in last column
        If ColumnCount = Selection.Columns.Count Then
            ' If so then write a blank line
            TableData = TableData & Chr$(10)
        End If

        ' Start next iteration of ColumnCount loop
        Next ColumnCount

    ' Start next iteration of RowCount loop
    Next RowCount

    ' Copy data to the clipboard
    ClipboardData.SetText TableData
    ClipboardData.PutInClipboard
End Sub

Sub ColorToRGB(ByVal Color As String, ByRef r, ByRef g, ByRef b)

On Error GoTo Solution
Dim SStr As String
SStr = "000000" & Hex(Color)
SStr = Right(SStr, 6)
b = Mid(SStr, 1, 2)
g = Mid(SStr, 3, 2)
r = Mid(SStr, 5, 2)

If Len(r) < 2 Then r = "0" & r
If Len(g) < 2 Then g = "0" & g
If Len(b) < 2 Then b = "0" & b

Solution:
    If Err.Number <> 0 Then
        r = -1
        g = -1
        b = -1
    End If
End Sub