将Excel表转换为TiddlyWiki格式文件
TiddlyWiki 是个不错的工具，但对于表格的处理比较繁琐，如果能用Excel处理表格而将结果导入TiddlyWiki，将大大提高效率，减少差错。
下面这个Excel宏来自 http://groups.google.com/group/TiddlyWiki/browse_thread/thread/575a9789ffc0ce0b 和这里 http://www.lacher.com/examples/a960521b.htm （这两个地址可能在国内无法访问！）
具体用法是：将下面的VBS代码作为宏载入一个Excel文件，关于Excel宏怎样添加及运行请在Excel中看有关帮助（按F1键），每次要转换Excel表，须先选中要转换的数据区域，然后运行此宏，按提示输入目标文件路径和文件名（Enter the destination filename with complete path），转换后的内容保存于此文件中，将其拷贝到TiddlyWiki就能看到效果，很棒！
Sub TiddlyWikiExport()
‘ Dimension all variables
Dim DestFile As String
Dim FileNum As Integer
Dim ColumnCount As Integer
Dim RowCount As Integer
Dim Clipboard As String‘ Prompt user for destination filename
DestFile = InputBox("Enter the destination filename" _
& Chr(10) & "(with complete path):", "Quote-Comma Exporter")‘ Obtain next free file handle number
FileNum = FreeFile()‘ Turn error checking off
On Error Resume Next‘ Attempt to open destination file for output
Open DestFile For Output As #FileNum‘ If an error occurs report it and end
If Err <> 0 ThenMsgBox "Cannot open filename " & DestFile
EndEnd If
‘ Turn error checking on
On Error GoTo 0‘ Loop for each row in selection
For RowCount = 1 To Selection.Rows.Count‘ Write the initial table tag
Print #FileNum, "|";‘ Loop for each column in selection
For ColumnCount = 1 To Selection.Columns.Count‘ 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
Print #FileNum, "bgcolor(#" & r & g & b & "): ";
End If‘ Write the initial bold tag
If Selection.Cells(RowCount, ColumnCount).Font.Bold = True Then
Print #FileNum, "”";
End If‘ Write the initial italics tag
If Selection.Cells(RowCount, ColumnCount).Font.Italic = True Then
Print #FileNum, "//";
End If‘ Write the initial strikethrough tag
If Selection.Cells(RowCount, ColumnCount).Font.Strikethrough = True Then
Print #FileNum, "—";
End If‘ Set right alignment
If Selection.Cells(RowCount, ColumnCount).HorizontalAlignment = xlRight Or Selection.Cells(RowCount, ColumnCount).HorizontalAlignment = xlCenter Then
Print #FileNum, " ";
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
Print #FileNum, "@@color(#" & r & g & b & "):";
End If‘ Write the initial hyperlink tag
If Selection.Cells(RowCount, ColumnCount).Hyperlinks.Count > 0 Then
Print #FileNum, "[[";
End If' Write current cell's text
Print #FileNum, Selection.Cells(RowCount, ColumnCount).Text;' Write the initial hyperlink tag
If Selection.Cells(RowCount, ColumnCount).Hyperlinks.Count > 0 Then
Print #FileNum, "|" & Selection.Cells(RowCount, ColumnCount).Hyperlinks(1).Address & "]]";
End If‘ Write the ending font color tag
If Selection.Cells(RowCount, ColumnCount).Font.Color <> vbBlack Then
Print #FileNum, "@@";
End If‘ Set left alignment
If Selection.Cells(RowCount, ColumnCount).HorizontalAlignment = xlLeft Or _
Selection.Cells(RowCount, ColumnCount).HorizontalAlignment = xlCenter Then
Print #FileNum, " ";
End If‘ Write the ending strikethrough tag
If Selection.Cells(RowCount, ColumnCount).Font.Strikethrough = True Then
Print #FileNum, "—";
End If‘ Write the ending italic tag
If Selection.Cells(RowCount, ColumnCount).Font.Italic = True Then
Print #FileNum, "//";
End If‘ Write the ending bold tag
If Selection.Cells(RowCount, ColumnCount).Font.Bold = True Then
Print #FileNum, "”";
End If‘ Write the ending table separator
Print #FileNum, "|";‘ Check if cell is in last column
If ColumnCount = Selection.Columns.Count Then
‘ If so then write a blank line
Print #FileNum,
End If‘ Start next iteration of ColumnCount loop
Next ColumnCount‘ Start next iteration of RowCount loop
Next RowCount‘Close destination file
Close #FileNumEnd 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" & bSolution:
If Err.Number <> 0 Then
r = -1
g = -1
b = -1
End If
End Sub
其他代码参考：
1 >> Exporting Excel Data in Special Formats
You can use a VBA procedure to export data in comma delimited format. Or, change the delimiting character to export the data separated by semicolons, etc.
Microsoft Knowledgebase Article
PSS ID Number: Q123183
Article last modified on 09-15-1995
PSS database name: EXCEL
5.00 5.00c 7.00 | 5.00
WINDOWS | MACINTOSH
——————————————————————–
The information in this article applies to:
- Microsoft Excel for Windows, versions 5.0, 5.0c
- Microsoft Excel for Windows 95, version 7.0
- Microsoft Excel for the Macintosh, version 5.0 ——————————————————————–
SUMMARY
=======
In Microsoft Excel, there is no menu command to automatically export
data to a text file so that the text file is exported with quotation
marks AND commas as delimiters. For example, there is no command to
automatically create a text file that contains the following:
"Text1","Text2","Text3"
You can create this functionality in Microsoft Excel by using a
Visual Basic procedure.
MORE INFORMATION
================
You can use the Print # statement in a Visual Basic procedure similar to the following to export a text file with quotation marks AND commas as the delimiters. For the procedure to function properly, you must select the cells that contain your data before you run it. Microsoft provides examples of Visual Basic procedures for illustration only, without warranty either expressed or implied, including but not limited to the implied warranties of merchantability and/or fitness for a particular purpose. This Visual Basic procedure is provided ‘as is’ and Microsoft does not guarantee that it can be used in all situations. Microsoft does not support modifications of this procedure to suit customer requirements for a particular purpose. Note that a line that is preceded by an apostrophe introduces a comment in the code–comments are provided to explain what the code is doing at a particular point in the procedure. Note also that an underscore character (_) indicates that code continues from one line to the next. You can type lines that contain this character as one logical line or you can divide the lines of code and include the line continuation character. For more information about Visual Basic for Applications programming style, see the "Programming Style in This Manual" section in the "Document Conventions" section of the "Visual Basic User’s Guide."
Sub QuoteCommaExport()
‘ Dimension all variables
Dim DestFile As String
Dim FileNum As Integer
Dim ColumnCount As Integer
Dim RowCount As Integer
‘ Prompt user for destination filename
DestFile = InputBox("Enter the destination filename" _
& Chr(10) & "(with complete path):", "Quote-Comma Exporter")‘ Obtain next free file handle number
FileNum = FreeFile()‘ Turn error checking off
On Error Resume Next‘ Attempt to open destination file for output
Open DestFile For Output As #FileNum‘ If an error occurs report it and end
If Err <> 0 ThenMsgBox "Cannot open filename " & DestFile
EndEnd If
‘ Turn error checking on
On Error GoTo 0‘ 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 current cell’s text to file with quotes
Print #FileNum, """" & Selection.Cells(RowCount, _
ColumnCount).Text & """";‘ Check if cell is in last column
If ColumnCount = Selection.Columns.Count Then‘ If so then write a blank line
Print #FileNum,
Else‘ Otherwise write a comma
Print #FileNum, ",";End If
‘ Start next iteration of ColumnCount loop
Next ColumnCount‘ Start next iteration of RowCount loop
Next RowCount‘Close destination file
Close #FileNumEnd Sub
For additional information, please see the following article(s) in the Microsoft Knowledge Base:
ARTICLE-ID: Q103985
TITLE : Macro to Export Text File with Comma AND Quote Delimiters
KBCategory: kbprg kbcode
KBSubcategory:
Additional reference words: 7.00 5.00 5.00c export quotes commas csv
——
2 >> Using Visual Basic
(Original code: http://tiddlywiki.pastebin.com/f7848a6a7)
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
code
' 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
![image_thumb[2]](http://5d0d.net/files/2009/11/image21.png)
