Attribute VB_Name = "ExportToTwiki1"
' Save this file to disk, In excel choose:
'   Tools -> Macros -> "Visual Basic Editor"
' Right click on "VBA Project (Personal.XLS)"
' Choose "Import File"
' Exit the window by clicking on the X decoration at the upper right,
'   or use Alt-Q, or choose File -> return to excel.
'
' Because you added this macro to your personal.XLS, it will
'   be available for all the spreadsheets you open.
'
' To export the current spreadsheet in TWiki format type Alt-F8 and
'    choose ExportDBToTWiki.
' To upload, open the export file in notepad or wordpad, copy and
'    paste into the TWiki edit window.

Sub ExportDBToTWiki()

' This macro saves the active worksheet to a pipe-delimited flat file
' with a user choosable file. It does not clear embedded
' pipe characters.

' Updated 8/14/2003 to also strip those pesky ALT-ENTER chars that Excel allows within a cell
' ALT-ENTER embeds a CHR$(10) - the added code strips these out and replaces with a space.
' Also, changed GetSaveAsFilename so that the save dir was whever you saved to last - just in case
' you have a lot of tabbed sheets to convert!

' Updated 11/3/2004 to put asterisks around bold cells.

Dim SrcRg As Range
Dim CurrRow As Range
Dim CurrCell As Range
Dim CurrTextStr As String
Dim ListSep As String
Dim BoldChar As String
Dim DataTextStr As String
Dim FileName As String
Dim TempChar As String
Dim TempCharCode As Integer
Dim TempString As String
Dim HardReturn As String
Dim HardReturnCode As Integer




Dim Filter As String
Filter = "All Files (*.*),*.*"
Dim Title As String
Title = "Select the Output File Name"

ListSep = "|"
BoldChar = "*"
HardReturn = Chr$(10)

Set SrcRg = ActiveSheet.UsedRange

FileName = Application.GetSaveAsFilename(CurDir(""), Filter, , Title)
                    
' stop if user clicked cancel
If (FileName = "False") Then
  Exit Sub
End If

'Check for a trailing period and strip it.
If Right(FileName, 1) = "." Then
'Remove the period from the string.
   FileName = Left(FileName, Len(FileName) - 1)
End If

Open FileName For Output As #1

For Each CurrRow In SrcRg.Rows
  CurrTextStr = ListSep

  For Each CurrCell In CurrRow.Cells
    If (CurrCell.Value = "") Then
      ' two || next to each other spans columns. Add a space
      ' if the value is empty so that we preserve the column
      ' format
      CurrTextStr = CurrTextStr & " " & ListSep
    ElseIf (CurrCell.Font.Bold) Then
      ' Add bold, usually for headings.
      CurrTextStr = CurrTextStr & BoldChar & CurrCell.Value & BoldChar & ListSep
    Else
      CurrTextStr = CurrTextStr & CurrCell.Value & ListSep
    End If
    Next
    
  ' Look for occurrances of hard-returns in the cell data, replace with a space
  TempString = ""
  For i = 1 To Len(CurrTextStr)
    TempChar = Mid(CurrTextStr, i, 1)
    If TempChar = HardReturn Then
            TempString = TempString & " "
    Else
            TempString = TempString & TempChar
    End If
  Next i
  
  CurrTextStr = TempString
            
  While Right(CurrTextStr, 1) = ListSep
    CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)
  Wend
  'Added next line to put | at end of each line
  CurrTextStr = CurrTextStr & ListSep
  Print #1, CurrTextStr

Next

Close #1
End Sub