This is a simple VBA macro for exporting an Excel table selection in JSPWiki table syntax to the clipboard. The clipboard functionality requires the Microsoft Forms 2.0 "Reference" (from the VBA tool, Tools->References, Browse..., open FM20.dll). Note: Only 1 hyperlink is parsed per cell.

I don't know VBA, so please correct errors as you see them.

Rem  *****  BASIC  *****
Sub JSPWikiExport()

    ' 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
    
        ' Loop for each column in selection
        For ColumnCount = 1 To Selection.Columns.Count

        ' Write the initial table tag
        TableData = TableData & "|"
        
         ' Do header formatting for the first row
         ' Removed, first row not always a header, depend on font formatting instead
         'If RowCount = 1 Then
         '    TableData = TableData & "|"
         'End If
        
            ' Write the initial 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 & "%%(background-color: #" & 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 & "%%strike "
            End If
            
            ' Write the initial underline tag if it is underlined and not a hyperlink
            If Selection.Cells(RowCount, ColumnCount).Font.Underline = xlUnderlineStyleSingle And _
               Selection.Cells(RowCount, ColumnCount).Hyperlinks.Count < 1 Then
                TableData = TableData & "%%(text-decoration:underline) "
            End If
    
            ' Write initial right alignment
            If Selection.Cells(RowCount, ColumnCount).HorizontalAlignment = xlRight Then
                TableData = TableData & "%%(text-align:right;display:block) "
            End If
            
            ' Write inital center alignment
            If Selection.Cells(RowCount, ColumnCount).HorizontalAlignment = xlCenter Then
                TableData = TableData & "%%(text-align:center;display:block) "
            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
        
        ' Prepare current cell's text
        Content = Replace(Selection.Cells(RowCount, ColumnCount).Text, Chr$(10), " \\ ")
        
        ' Add a space for empty cells
        If Content = "" Then
             Content = " "
        End If
        
        ' Append current cell to table data
        TableData = TableData & Content
           
           ' Write the ending 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
           
           ' Write center alignment end tag
           If Selection.Cells(RowCount, ColumnCount).HorizontalAlignment = xlCenter Then
               TableData = TableData & "%%"
           End If
            
           ' Write center alignment end tag
           If Selection.Cells(RowCount, ColumnCount).HorizontalAlignment = xlRight 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
           
           ' Write the ending underline tag if it is underlined and not a hyperlink
           If Selection.Cells(RowCount, ColumnCount).Font.Underline = xlUnderlineStyleSingle And _
              Selection.Cells(RowCount, ColumnCount).Hyperlinks.Count < 1 Then
               TableData = TableData & "%%"
           End If
           
           ' Write ending 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 & "%%"
           End If
        
           ' 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

Add new attachment

Only authorized users are allowed to upload new attachments.
« This page (revision-3) was last changed on 10-Jun-2008 03:05 by JTThomas