Excel表等からテキストテーブル作成するスクリプト（メモ）

エクセルなどに作った　表を　テキストベースに変換するVBS

エクセルの表を選択コピーして、vbsを実行すると、クリップボードからデータを取得して、変換後クリップボードに再度入れます

（自分メモ）
使い方：ソースをコピーして （xxxxxx）.vbs　xxxxxxは適当に　として保存します
あとは
エクセルの領域を選択してctrl+c
vbsをダブルクリックで実行します。
エディタなどに ctrl+v
これだけです。

dim tblText
dim lines
dim fields
dim line_lens()
dim field_lens
dim field_max

dim hankaku
dim zenkaku

dim hankaku_len
dim zenkaku_len
dim coLen

field_max=0

'-------------------------------------------------
Set objRegExp = new RegExp

tblText = GetClipBoardText()


objRegExp.Pattern = "[\r\n]+$"
tblText = objRegExp.Replace(tblText,"")


'-------------------------------------------------
objRegExp.Global = true
objRegExp.Pattern = "[\t]+"
tblText = objRegExp.Replace(tblText,vbTab)

'-------------------------------------------------
objRegExp.Pattern = "[\t]+\r\n"
tblText = objRegExp.Replace(tblText,vbCrLf)
objRegExp.Pattern = "[\t]+$"
tblText = objRegExp.Replace(tblText,"")
'-------------------------------------------------
objRegExp.Pattern = "[\n]+"
tblText = objRegExp.Replace(tblText," ") 'なんで" "なんだろ？
'-------------------------------------------------
lines = split(trim(tblText),vbCr)
'最大値取得
for i= 0 to UBound(lines)
	fields = split(lines(i),vbTab)
	lines(i) = fields
	if(field_max < Ubound(fields)) then
		field_max = Ubound(fields)
	end if
next

Redim field_lens(field_max)

for i = 0 to UBound(field_lens)
	field_lens(i) = 0
next

'各カラム幅の最大値を取得する

for i = 0 to UBound(lines)

	fields = lines(i)

	for j = 0 to UBound(fields)
		colLen = LengthByHankaku(fields(j))
		'偶数化
		colLen = colLen + (colLen Mod 2)
		'
		if field_lens(j) < colLen then
			field_lens(j) = colLen
		end if
	next
next

'-----------------------------------------------------------上線
outStr = "┌"

for i = 0 to UBound(field_lens)
	outStr = outStr & String(field_lens(i)/2,"─")
	if i < UBound(field_lens) then
		outStr = outStr & "┬"
	else
		outStr = outStr & "┐"
	end if
next

'-----------------------------------------------------------出力
for i=0 to UBound(lines)
	fields=lines(i)
	outStr = outStr & vbCrLf
	for j=0 to UBound(fields)
		outStr = outStr & String(1,"│")
		'カラムの文字列をセットする
		objRegExp.Pattern = "^[0-9, ]+$" '数字とカンマのみ
		if objRegExp.Test(fields(j)) = true then
			'数字のみは右詰め
			outStr = outStr & String(field_lens(j) -LengthByHankaku(fields(j))," ") & fields(j)
		else
			outStr = outStr & fields(j) & String(field_lens(j) -LengthByHankaku(fields(j))," ") 
		end if
	next
	outStr = outStr & String(1,"│")
	'----------------------------------------------------下線
	if i < UBound(lines) then
		'中間行
		LT = "├"
		MD = "┼"
		RT = "┤"
	else
		LT = "└"
		MD = "┴"
		RT = "┘"
	end if
	
	'罫線
	outStr = outStr & vbCrLf
	outStr = outStr & String(1,LT)
	for j= 0 to UBound(fields)
		outStr = outStr & String(field_lens(j)/2,"─")
		if j< UBound(fields) then
			outSTr = outStr & String(1,MD)
		else
		end if
	next
	'右端
	outSTr = outStr & String(1,RT)
next

SetClipboardText(outStr)
MsgBox("クリップボードにコピーしました")

'-----------------------------------------------------------------
'半角換算文字数
'-----------------------------------------------------------------
Function LengthByHankaku(str)
	Set RegExp = New RegExp
	RegExp.Global = true
	'半角文字数
	RegExp.Pattern ="[^\x01-\x7E]+"
	'半角以外をリプレース　半角が残る
	hankaku = RegExp.Replace(str,"")
	'全角文字数
	RegExp.Pattern ="[\x01-\x7E]+"
	'半角をリプレース　全角が残る
	zenkaku = RegExp.Replace(str,"")
	'換算文字数
	colLen = Len(zenkaku)*2 +Len(hankaku)
	LengthByHankaku = colLen
End Function

'------------------------------------------------------------------
'クリップボード取得
'------------------------------------------------------------------
Function GetClipBoardText()
	dim objHTML
	Set objHTML = CreateObject("htmlfile")
	GetClipBoardText = Trim(objHTML.ParentWindow.ClipboardData.GetData("Text"))
End Function

'------------------------------------------------------------------
'クリップボードコピー
'------------------------------------------------------------------
Function SetClipboardText(text)
	set WshShell = CreateObject("WScript.Shell")
	wshShell.Exec("clip").stdIn.write text
	Set wshShell = nothing
End Function