Excel VBA Qiitaの表のマークダウンをExcelで作るマクロ

ファイル名は Const SaveFileName = "C:\hoge\sheetttxt.txt"
で決めています。上書きするので、必要なものは別名で保存してください。
タイトルは1行目のみに入れます。
またセル内の途中改行（ALT+Enter)は反映されない可能性があります。
あくまでも簡易なものです。

MakeSheetText

Sub MakeSheetText()
'Dim sr As ADODB.Stream: Set sr = New ADODB.Stream
Dim sr As Object: Set sr = CreateObject("ADODB.Stream")
Dim r As Range, URng As Range
Dim i As Long, i1 As Long, irow As Long, icol As Long, lastrow As Long, lastcol As Long
Dim ws As Worksheet: Set ws = ActiveSheet
Dim buf As String
Dim MaxWidth()
Const adCRLF = -1
Const adTypeText = 2
Const adWriteLine = 1
Const adModeReadWrite = 3
Const adSaveCreateOverWrite = 2
Const SaveFileName = "C:\hoge\sheetttxt.txt" 
sr.Type = adTypeText
sr.LineSeparator = adCRLF
sr.Charset = "SJis"
'sr.Charset = "UTF-8"
sr.Mode = adModeReadWrite
sr.Open
Set URng = ws.UsedRange
lastrow = URng.Rows.Count
lastcol = URng.Columns.Count
For icol = 1 To lastcol
i1 = 0
'最大値採寸
For irow = 1 To lastrow
If i1 < Len(CStr(ws.Cells(irow, icol).Value)) Then i1 = Len(CStr(ws.Cells(irow, icol).Value))

Next
ReDim Preserve MaxWidth(1 To icol)

MaxWidth(icol) = i1
Next
buf = ""
For irow = 1 To 1
For icol = 1 To lastcol
If Len(CStr(ws.Cells(irow, icol).Value)) < 5 Then
buf = buf & "|" & CStr(ws.Cells(irow, icol).Value) & String(5 - Len(CStr(ws.Cells(irow, icol).Value)), " ")
Else
buf = buf & "|" & CStr(ws.Cells(irow, icol).Value)
End If
Next icol
Next irow
sr.WriteText buf & "|", adWriteLine

buf = ""
'書式決定行
For icol = 1 To lastcol
If MaxWidth(icol) < 5 Then
buf = buf & "|:----:" 'Center
'buf = buf & "|:-----" 'Left
'buf = buf & "|-----:" 'Right
Else
buf = buf & "|:" & String(MaxWidth(icol) - 5, "-") & ":"

End If

Next icol
sr.WriteText buf & "|", adWriteLine
'2行目以降
For irow = 2 To lastrow
buf = ""
For icol = 1 To lastcol
If buf <> "" Then
buf = buf & "|" & CStr(ws.Cells(irow, icol).Value)
Else
buf = buf & "| " & CStr(ws.Cells(irow, icol).Value)
End If
Next icol
sr.WriteText buf & "|", adWriteLine
Next irow

sr.SaveToFile SaveFileName, adSaveCreateOverWrite

End Sub