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