SQLの窓

2019年02月13日


Windows ロゴキーを使ったショートカットの覚える優先順位



E xplorer
R un
S earch
D esktop

I : Windows の設定







画面の一部のスクリーン ショットを撮影する
※ ドラッグでデスクトップを切り取り



Windows ロゴ キー + Pause

コンピュータのプロパティを開く






Microsoft ドキュメント

Windows のキーボード ショートカット




posted by lightbox at 2019-02-13 14:20 | Windows10 | このブログの読者になる | 更新情報をチェックする

SQLServer の SQL でテーブルの日付が前月かどうかで条件を作成する

まず、dateadd と datepart の機能を確認する為の SQL が以下のようになります。

※ m と mm は month の省略形です
select
	cast('2019/01/01' as datetime),
	dateadd(month, -1, getdate()),
	dateadd(m, -1, getdate()),
	dateadd(mm, -1, getdate()),

	case
	when datepart(year, cast('2019/01/01' as datetime)) = datepart(year, dateadd(month, -1, getdate()))
	 	then '一致しました'
		else '一致しません'
	end as 年比較,

	case
	when datepart(month, cast('2019/01/01' as datetime)) = datepart(month, dateadd(month, -1, getdate()))
	 	then '一致しました'
		else '一致しません'
	end as 月比較

▼ これを踏まえて条件にしたものです。
select *

from [テーブル名]

where
	DATEPART(year, 対象日付) = DATEPART(year, DATEADD(m, -1, GETDATE()))
and	DATEPART(m, 対象日付) = DATEPART(m, DATEADD(m, -1, GETDATE()))


現在の年月日を getdate() で取得し、その月を一つマイナスして年部分と月部分を別々に取得して、比較したい日付の年部分と月部分がどちらも一致していたら、前月です。


関連する Microsoft ドキュメント

DATEADD (Transact-SQL)

DATEPART (Transact-SQL)

CAST および CONVERT (Transact-SQL)

CASE (Transact-SQL)




posted by lightbox at 2019-02-13 12:11 | システム開発 | このブログの読者になる | 更新情報をチェックする

2019年02月12日


エクスプローラを右クリックしてそのフォルダで「コマンドプロント」を開くメニューを追加する .reg ファイル

エクスプローラを右クリックしてコマンドプロンプトを開きたい場合は、以下のレジストリをインポートします(右端のダウンロードアイコンでダウンロード / 拡張子 .reg )
Windows Registry Editor Version 5.00
 
[HKEY_CLASSES_ROOT\Folder\shell\cmd]
@="コマンドプロンプト(&P)"
 
[HKEY_CLASSES_ROOT\Folder\shell\cmd\command]
@="cmd.exe /s /k pushd \"%V\""

▼ 削除は以下です
Windows Registry Editor Version 5.00
 
[-HKEY_CLASSES_ROOT\Folder\shell\cmd]
 


▼ インストール場所をレジストリエディタで開くスクリプトをダウンロードします




posted by lightbox at 2019-02-12 21:59 | コマンドプロンプト | このブログの読者になる | 更新情報をチェックする

2019年02月11日


jQuery : 貼り付けるだけで、ページ右下にページ先頭にジャンプするリンクを表示させる( アニメーションは無し )

このブログで実装しているものを jQuery に置き換えたものです。リンクは、スクロールしていない先頭では表示されませんが、少しスクロールすると表示されます。
<script src="https://ajax.googleapis.com/ajax/libs/jquery/3.3.1/jquery.min.js"></script>
<script>
$(function(){

	// ページ右下固定位置のリンク
	var scroll_top = $("<a id='scroll_top'>▲</a>")
	scroll_top.prop("href","javascript:void(0)");
	scroll_top.css({ 
		"position": "fixed",
		"text-decoration": "none",
		"font-size" : "40px",
		"color" : "rgba(255,255,255,0.85)",
		"text-shadow" : "1px 1px 2px #656a6f",
		"right" : "0.5%",
		"bottom" : "5rem",
		"display" : "none"
	});

	// クリックした時の処理
	scroll_top.on("click", function(){
		window.scroll(0,0);
	});

	// ページの最後に追加
	$("body").append( scroll_top );

	// スクロールが無い先頭部分では表示しない
	$(window).on("scroll",function(){
		var scroll = $("html").scrollTop();
		if ( scroll <= 200 && $("#scroll_top").css("display") != "none" ) {
			$("#scroll_top").css("display","none");
		}
		if ( scroll > 200 && $("#scroll_top").css("display") == "none" ) {
			$("#scroll_top").css("display","");
		}
	});	

});
</script>







タグ:スクロール
posted by lightbox at 2019-02-11 22:01 | jQuery | このブログの読者になる | 更新情報をチェックする

簡易詳細設計書(A4)作成 : VBScript + Excel.Application

Microsoft Excel がインストールされている必要があります

Excel 2007 以降の場合、.xls で保存する形式として 97-2003 として保存するようにしています。VBScript のライブラリはWEB上にあり、それらを参照して実行しています

実行すると、ドキュメントフォルダに作成されます
function CreateBook(BookPath)

	ExcelInit

	ExcelApp.DisplayAlerts = False

	ExcelApp.Workbooks.Add
	nBooks = ExcelApp.Workbooks.Count
	Set CreateBook = ExcelApp.Workbooks( nBooks )
	CreateBook.Activate

	on error resume next

	if CLng(Left(ExcelApp.Version & "",2 )) > 11 then
		Call CreateBook.SaveAs( BookPath, 56 )
	else
		Call CreateBook.SaveAs( BookPath )
	end if


	if Err.Number <> 0 then
		CreateBook = "ERROR:" & Err.Description
	end if
	on error goto 0

End Function



作成されるのは、非常にシンプルな4種類の設計書フォーマットです。
1) 概要書
 処理を中心とした入出力をオートシェイプの
 フローチャートで示し、概要を記述して正確
 な入出力エントリ列挙します
2) 画面設計書
 最近では画面の画像をはりつける事がほとん
 どです
3) 入力設計書
 入力チェックを中心とした GUI の操作手順を
 ベースとしてアプリケーションの定義をして
 いきます。入力フィールドの属性も通常示さ
 れます
4) 出力設計書
 更新処理はここで記述されます。最近では、
 DBテーブルの更新仕様と考えて良いでしょう。
 但し例外として、印刷処理のフォーマット指示
 である事もあります
作成するのは、詳細設計書書式なのですが、もし、VBScript を書く事ができるのであれば、Excel にアクセスしている部分は WEB 上のライブラリですが、常に Hosting しているので利用していただいて結構です。

ライブラリそのものは、テキストとして Hosting しているので、都合上 UTF-8 で書かれています。以下からダウンロード可能です。

baseFunction.vbs
excelFunction.vbs

※ 以下は仕様を書き込んだ作成イメージです

<JOB>
<COMMENT>
************************************************************
 WSH 実行スケルトン
************************************************************
</COMMENT>

<COMMENT>
************************************************************
 外部スクリプト定義
************************************************************
</COMMENT>
<SCRIPT
	language="VBScript"
	src="http://lightbox.in.coocan.jp/laylaClass.vbs">
</SCRIPT>

<SCRIPT language=VBScript>
' ***********************************************************
' 処理開始
' ***********************************************************
Call laylaFunctionTarget( "http://lightbox.in.coocan.jp/" )
Call laylaLoadFunction( "baseFunction.vbs" )
Call laylaLoadFunction( "excelFunction.vbs" )

Crun

str = InputBox( MyDocDir & " に作成されるExcelブック名を指定します",, _
	"簡易詳細設計書フォーマット" )
if str = "" then
	Wscript.Quit
end if

strTarget = MyDocDir & "\" & str & ".xls"

Set MyBook = CreateBook( strTarget )
' Call ExcelVisible( True )

' ******************************************************
' 画面設計書フォーマット作成
' ******************************************************
strSheetName = "画面設計書"
Wscript.Echo strSheetName & " を作成しています"

Call AddSheetTop(MyBook, strSheetName)
Call ExcelSelectSheet(MyBook, strSheetName)
on error resume next
Call DeleteSheet( MyBook, "Sheet1" )
Call DeleteSheet( MyBook, "Sheet2" )
Call DeleteSheet( MyBook, "Sheet3" )
on error goto 0

Call Format_Page(MyBook)

Call ExcelSize_Disp(MyBook, strSheetName)
Call ExcelLine_Disp(MyBook, strSheetName)
Call ExcelSetText_Disp(MyBook, strSheetName)

' ******************************************************
' 概要書
' ******************************************************
strSheetName = "概要書"
Wscript.Echo strSheetName & " を作成しています"

Call AddSheetTop(MyBook, strSheetName)
Call ExcelSelectSheet(MyBook, strSheetName)
Call Format_Page(MyBook)
Call ExcelSize_Plan(MyBook, strSheetName)
Call ExcelLine_Plan(MyBook, strSheetName)
Call ExcelSetText_Plan(MyBook, strSheetName)

' ******************************************************
' 入力設計書
' ******************************************************
strSheetName = "入力設計書"
Wscript.Echo strSheetName & " を作成しています"

Call AddSheetLast(MyBook, strSheetName)
Call ExcelSelectSheet(MyBook, strSheetName)
Call Format_Page(MyBook)
Call ExcelSize_Plan(MyBook, strSheetName)
Call ExcelLine_Plan(MyBook, strSheetName)
Call ExcelSetText_Plan(MyBook, strSheetName)

' ******************************************************
' 出力設計書
' ******************************************************
strSheetName = "出力設計書"
Wscript.Echo strSheetName & " を作成しています"

Call AddSheetLast(MyBook, strSheetName)
Call ExcelSelectSheet(MyBook, strSheetName)
Call Format_Page(MyBook)
Call ExcelSize_Plan(MyBook, strSheetName)
Call ExcelLine_Plan(MyBook, strSheetName)
Call ExcelSetText_Plan(MyBook, strSheetName)


' ******************************************************
' 終了処理
' ******************************************************
Call ExcelSave( MyBook )
Call ExcelQuit( MyBook )
Call ExcelLoad( Dd(strTarget) )

' ******************************************************
' セルサイズの設定
' ******************************************************
Function ExcelSize_Disp(MyBook, Target)

	'セルの高さ合わせ
	Call ExcelSetRowHeight(MyBook, Target, 1, 13.50)
	Call ExcelSetRowHeight(MyBook, Target, 2, 24.50)
	Call ExcelSetRowHeight(MyBook, Target, 3, 13.50)
	Call ExcelSetRowHeight(MyBook, Target, 4, 24.50)

	For i = 5 To 25
		Call ExcelSetRowHeight(MyBook, Target, i, 24.75)
	Next

	For i = 26 To 38
		Call ExcelSetRowHeight(MyBook, Target, i, 19.00)
	Next

	'セルの幅合わせ
	Call ExcelSetColumnWidth(MyBook, Target, 1, 3.50)
	Call ExcelSetColumnWidth(MyBook, Target, 2, 22.38)
	Call ExcelSetColumnWidth(MyBook, Target, 3, 7.50)
	Call ExcelSetColumnWidth(MyBook, Target, 4, 6.00)
	Call ExcelSetColumnWidth(MyBook, Target, 5, 6.00)
	Call ExcelSetColumnWidth(MyBook, Target, 6, 11.50)
	Call ExcelSetColumnWidth(MyBook, Target, 7, 25.00)
	Call ExcelSetColumnWidth(MyBook, Target, 8, 12.00)

End Function

' ******************************************************
' 罫線の設定
' ******************************************************
Function ExcelLine_Disp(MyBook, Target)

	' BOX罫線
	Call ExcelRange(MyBook, Target, 1, 1, 8, 38 )
	Call ExcelBox(xlContinuous, xlMedium)

	' 上罫線
	Call ExcelRange(MyBook, Target, 1, 2, 8, 2 )
	Call ExcelLine(xlDot, xlThin)

	Call ExcelRange(MyBook, Target, 1, 3, 8, 3 )
	Call ExcelLine(xlContinuous, xlThin)

	Call ExcelRange(MyBook, Target, 1, 4, 8, 4 )
	Call ExcelLine(xlDot, xlThin)

	Call ExcelRange(MyBook, Target, 1, 5, 8, 5 )
	Call ExcelLine(xlContinuous, xlMedium)

	Call ExcelRange(MyBook, Target, 1, 26, 8, 26 )
	Call ExcelLine(xlContinuous, xlMedium)

	for i = 27 to 38
		Call ExcelRange(MyBook, Target, 1, i, 8, i )
		Call ExcelLine(xlDot, xlThin)
	Next

	' 右罫線
	Call ExcelRange(MyBook, Target, 2, 1, 2, 4 )
	Call ExcelLineRight(xlContinuous, xlThin)

	Call ExcelRange(MyBook, Target, 6, 1, 6, 4 )
	Call ExcelLineRight(xlContinuous, xlThin)

	Call ExcelRange(MyBook, Target, 7, 1, 7, 4 )
	Call ExcelLineRight(xlContinuous, xlThin)

End Function

' ******************************************************
' セルのテキストの設定
' ******************************************************
Function ExcelSetText_Disp(MyBook, Target)

	Call ExcelRange(MyBook, Target, 1, 1, 7, 49 )
	Call ExcelVAlign()

	' 1行目
	Call ExcelSetCell(MyBook, Target, 1, 1, " システム名")
	Call ExcelSetCell(MyBook, Target, 3, 1, " サブシステム名")
	Call ExcelSetCell(MyBook, Target, 7, 1, " プログラムID")
	Call ExcelSetCell(MyBook, Target, 8, 1, "ページ")
	Call ExcelRange(MyBook, Target, 8, 1, 8, 1 )
	Call ExcelHAlign()

	' 2行目
	Call ExcelSetCell(MyBook, Target, 8, 2, "/")
	Call ExcelRange(MyBook, Target, 8, 2, 8, 2 )
	Call ExcelHAlign()

	' 3行目
	Call ExcelSetCell(MyBook, Target, 1, 3, " 画面ID")
	Call ExcelSetCell(MyBook, Target, 3, 3, " 画面名")

	Call ExcelSetCell(MyBook, Target, 7, 3, "作成日")
	Call ExcelRange(MyBook, Target, 7, 3, 7, 3 )
	Call ExcelHAlign()

	Call ExcelSetCell(MyBook, Target, 8, 3, "作成者")
	Call ExcelRange(MyBook, Target, 8, 3, 8, 3 )
	Call ExcelHAlign()

	' 4行目
	Call ExcelRange(MyBook, Target, 7, 4, 7, 4 )
	Call ExcelHAlign()

	Call ExcelRange(MyBook, Target, 8, 4, 8, 4 )
	Call ExcelHAlign()

End Function

' ******************************************************
' セルサイズの設定
' ******************************************************
Function ExcelSize_Plan(MyBook, Target)

	if Target = "概要書" then

		'セルの高さ合わせ
		Call ExcelSetRowHeight(MyBook, Target, 1, 13.50)
		Call ExcelSetRowHeight(MyBook, Target, 2, 24.50)
		Call ExcelSetRowHeight(MyBook, Target, 3, 13.50)
		Call ExcelSetRowHeight(MyBook, Target, 4, 24.50)
		Call ExcelSetRowHeight(MyBook, Target, 5, 24.50)
		Call ExcelSetRowHeight(MyBook, Target, 34, 20.25)

		For i = 6 To 49
			if 6 <= i AND i <= 33then
				Call ExcelSetRowHeight(MyBook, Target, i, 13.50)
			elseif 35 <=  i AND i  <= 44 then
				Call ExcelSetRowHeight(MyBook, Target, i, 24.50)
			elseif 45 <=  i AND i  <= 49 then
				Call ExcelSetRowHeight(MyBook, Target, i, 18.50)
			end if
		Next

		'セルの幅合わせ
		Call ExcelSetColumnWidth(MyBook, Target, 1, 3.50)
		Call ExcelSetColumnWidth(MyBook, Target, 2, 22.38)
		Call ExcelSetColumnWidth(MyBook, Target, 3, 12.38)
		Call ExcelSetColumnWidth(MyBook, Target, 4, 8.25)
		Call ExcelSetColumnWidth(MyBook, Target, 5, 11.50)
		Call ExcelSetColumnWidth(MyBook, Target, 6, 25.00)
		Call ExcelSetColumnWidth(MyBook, Target, 7, 12.00)

	elseif Target = "入力設計書" then

		'セルの高さ合わせ
		Call ExcelSetRowHeight(MyBook, Target, 1, 13.50)
		Call ExcelSetRowHeight(MyBook, Target, 2, 24.50)
		Call ExcelSetRowHeight(MyBook, Target, 3, 13.50)
		Call ExcelSetRowHeight(MyBook, Target, 4, 24.50)
		Call ExcelSetRowHeight(MyBook, Target, 5, 20.25)

		For i = 6 To 38
			if 6 <= i AND i <= 25then
				Call ExcelSetRowHeight(MyBook, Target, i, 24.75)
			elseif 26 <=  i AND i  <= 38 then
				Call ExcelSetRowHeight(MyBook, Target, i, 19.00)
			end if
		Next

		'セルの幅合わせ
		Call ExcelSetColumnWidth(MyBook, Target, 1, 3.50)
		Call ExcelSetColumnWidth(MyBook, Target, 2, 22.38)
		Call ExcelSetColumnWidth(MyBook, Target, 3, 7.50)
		Call ExcelSetColumnWidth(MyBook, Target, 4, 6.00)
		Call ExcelSetColumnWidth(MyBook, Target, 5, 6.00)
		Call ExcelSetColumnWidth(MyBook, Target, 6, 11.50)
		Call ExcelSetColumnWidth(MyBook, Target, 7, 25.00)
		Call ExcelSetColumnWidth(MyBook, Target, 8, 12.00)

	elseif Target = "出力設計書" then

		'セルの高さ合わせ
		Call ExcelSetRowHeight(MyBook, Target, 1, 13.50)
		Call ExcelSetRowHeight(MyBook, Target, 2, 24.50)
		Call ExcelSetRowHeight(MyBook, Target, 3, 13.50)
		Call ExcelSetRowHeight(MyBook, Target, 4, 24.50)
		Call ExcelSetRowHeight(MyBook, Target, 5, 20.25)

		For i = 6 To 38
			if 6 <= i AND i <= 25then
				Call ExcelSetRowHeight(MyBook, Target, i, 24.75)
			elseif 26 <=  i AND i  <= 38 then
				Call ExcelSetRowHeight(MyBook, Target, i, 19.00)
			end if
		Next

		'セルの幅合わせ
		Call ExcelSetColumnWidth(MyBook, Target, 1, 3.50)
		Call ExcelSetColumnWidth(MyBook, Target, 2, 22.38)
		Call ExcelSetColumnWidth(MyBook, Target, 3, 7.50)
		Call ExcelSetColumnWidth(MyBook, Target, 4, 6.00)
		Call ExcelSetColumnWidth(MyBook, Target, 5, 6.00)
		Call ExcelSetColumnWidth(MyBook, Target, 6, 11.50)
		Call ExcelSetColumnWidth(MyBook, Target, 7, 25.00)
		Call ExcelSetColumnWidth(MyBook, Target, 8, 12.00)

	end if

End Function

' ******************************************************
' 罫線の設定
' ******************************************************
Function ExcelLine_Plan(MyBook, Target)

	if Target = "概要書" then
		' BOX罫線
		Call ExcelRange(MyBook, Target, 1, 1, 7, 49 )
		Call ExcelBox(xlContinuous, xlMedium)

		' 上罫線
		Call ExcelRange(MyBook, Target, 1, 2, 7, 2 )
		Call ExcelLine(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 1, 3, 7, 3 )
		Call ExcelLine(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 1, 4, 7, 4 )
		Call ExcelLine(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 1, 5, 7, 5 )
		Call ExcelLine(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 5, 6, 7, 6 )
		Call ExcelLine(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 1, 34, 7, 34 )
		Call ExcelLine(xlContinuous, xlMedium)

		Call ExcelRange(MyBook, Target, 1, 35, 7, 35 )
		Call ExcelLine(xlContinuous, xlMedium)

		for i = 36 to 44
			' 線種→点線, 太さ→標準
			Call ExcelRange(MyBook, Target, 1, i, 7, i )
			Call ExcelLine(xlDot, xlThin)
		Next

		Call ExcelRange(MyBook, Target, 1, 45, 7, 45 )
		Call ExcelLine(xlContinuous, xlMedium)

		for i = 46 to 49
			' 線種→点線, 太さ→標準
			Call ExcelRange(MyBook, Target, 1, i, 7, i )
			Call ExcelLine(xlDot, xlThin)
		Next

		' 右罫線
		Call ExcelRange(MyBook, Target, 1, 35, 1, 44 )
		Call ExcelLineRight(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 4, 3, 4, 33 )
		Call ExcelLineRight(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 5, 1, 5, 4 )
		Call ExcelLineRight(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 6, 1, 6, 4 )
		Call ExcelLineRight(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 2, 34, 2, 44 )
		Call ExcelLineRight(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 3, 34, 3, 44 )
		Call ExcelLineRight(xlContinuous, xlThin)

	elseif Target = "入力設計書" then

		' BOX罫線
		Call ExcelRange(MyBook, Target, 1, 1, 8, 38 )
		Call ExcelBox(xlContinuous, xlMedium)

		' 上罫線
		Call ExcelRange(MyBook, Target, 1, 2, 8, 2 )
		Call ExcelLine(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 1, 3, 8, 3 )
		Call ExcelLine(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 1, 4, 8, 4 )
		Call ExcelLine(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 1, 5, 8, 5 )
		Call ExcelLine(xlContinuous, xlMedium)

		Call ExcelRange(MyBook, Target, 1, 6, 8, 6 )
		Call ExcelLine(xlContinuous, xlMedium)

		for i = 7 to 25
			Call ExcelRange(MyBook, Target, 1, i, 8, i )
			Call ExcelLine(xlDot, xlThin)
		Next

		Call ExcelRange(MyBook, Target, 1, 26, 8, 26 )
		Call ExcelLine(xlContinuous, xlMedium)

		for i = 27 to 38
			Call ExcelRange(MyBook, Target, 1, i, 8, i )
			Call ExcelLine(xlDot, xlThin)
		Next

		' 右罫線
		Call ExcelRange(MyBook, Target, 1, 6, 1, 25 )
		Call ExcelLineRight(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 2, 1, 2, 2 )
		Call ExcelLineRight(1, 2)

		Call ExcelRange(MyBook, Target, 2, 5, 2, 25 )
		Call ExcelLineRight(1, 2)

		Call ExcelRange(MyBook, Target, 3, 5, 3, 25 )
		Call ExcelLineRight(1, 2)

		Call ExcelRange(MyBook, Target, 4, 5, 4, 25 )
		Call ExcelLineRight(1, 2)

		Call ExcelRange(MyBook, Target, 5, 3, 5, 25 )
		Call ExcelLineRight(1, 2)

		Call ExcelRange(MyBook, Target, 6, 1, 6, 25 )
		Call ExcelLineRight(1, 2)

		Call ExcelRange(MyBook, Target, 7, 1, 7, 4 )
		Call ExcelLineRight(1, 2)

	elseif Target = "出力設計書" then

		' BOX罫線
		Call ExcelRange(MyBook, Target, 1, 1, 8, 38 )
		Call ExcelBox(xlContinuous, xlMedium)

		' 上罫線
		Call ExcelRange(MyBook, Target, 1, 2, 8, 2 )
		Call ExcelLine(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 1, 3, 8, 3 )
		Call ExcelLine(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 1, 4, 8, 4 )
		Call ExcelLine(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 1, 5, 8, 5 )
		Call ExcelLine(xlContinuous, xlMedium)

		Call ExcelRange(MyBook, Target, 1, 6, 8, 6 )
		Call ExcelLine(xlContinuous, xlMedium)

		for i = 7 to 25
			Call ExcelRange(MyBook, Target, 1, i, 8, i )
			Call ExcelLine(xlDot, xlThin)
		Next

		Call ExcelRange(MyBook, Target, 1, 26, 8, 26 )
		Call ExcelLine(xlContinuous, xlMedium)

		for i = 27 to 38
			Call ExcelRange(MyBook, Target, 1, i, 8, i )
			Call ExcelLine(xlDot, xlThin)
		Next

		' 右罫線
		Call ExcelRange(MyBook, Target, 1, 6, 1, 25 )
		Call ExcelLineRight(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 2, 1, 2, 2 )
		Call ExcelLineRight(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 2, 5, 2, 25 )
		Call ExcelLineRight(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 5, 3, 5, 4 )
		Call ExcelLineRight(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 6, 1, 6, 4 )
		Call ExcelLineRight(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 7, 1, 7, 25 )
		Call ExcelLineRight(xlContinuous, xlThin)
	end if

End Function

' ******************************************************
' セルのテキストの設定
' ******************************************************
Function ExcelSetText_Plan(MyBook, Target)

	if Target = "概要書" then

		Call ExcelRange(MyBook, Target, 1, 1, 7, 49 )
		Call ExcelVAlign()

		Call ExcelSetCell(MyBook, Target, 1, 1, " システム名")
		Call ExcelSetCell(MyBook, Target, 3, 1, " サブシステム名")
		Call ExcelSetCell(MyBook, Target, 6, 1, " プログラムID")
		Call ExcelSetCell(MyBook, Target, 1, 3, " プログラム名")
		Call ExcelSetCell(MyBook, Target, 1, 34, " テーブル名")

		Call ExcelSetCell(MyBook, Target, 7, 1, "ページ")
		Call ExcelRange(MyBook, Target, 7, 1, 7, 1 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 7, 2, "/")
		Call ExcelRange(MyBook, Target, 7, 2, 7, 2 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 5, 3, "種別")
		Call ExcelRange(MyBook, Target, 5, 3, 5, 3 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 6, 3, "作成日")
		Call ExcelRange(MyBook, Target, 6, 3, 6, 3 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 7, 3, "作成者")
		Call ExcelRange(MyBook, Target, 7, 3, 7, 3 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 5, 5, "処理概要")
		Call ExcelRange(MyBook, Target, 5, 5, 7, 5 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 3, 34, "入出力")
		Call ExcelRange(MyBook, Target, 3, 34, 3, 34 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 4, 34, "備考")
		Call ExcelRange(MyBook, Target, 4, 34, 7, 34 )
		Call ExcelHAlign()

		for i = 35 to 44
			Call ExcelSetCell(MyBook, Target, 1, i, i - 34)
			Call ExcelRange(MyBook, Target, 1, i, 1, i )

			' 配置
			Call ExcelHAlign()
			' 書式設定
			Call ExcelSetFont("太字", 12)
		next

	elseif Target = "入力設計書" then

		Call ExcelRange(MyBook, Target, 1, 1, 8, 38 )
		Call ExcelVAlign()

		Call ExcelSetCell(MyBook, Target, 1, 1, " システム名")

		Call ExcelSetCell(MyBook, Target, 3, 1, " サブシステム名")

		Call ExcelSetCell(MyBook, Target, 7, 1, " プログラムID")

		Call ExcelSetCell(MyBook, Target, 8, 1, "ページ")
		Call ExcelRange(MyBook, Target, 8, 1, 8, 1 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 8, 2, "/")
		Call ExcelRange(MyBook, Target, 8, 2, 8, 2 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 1, 3, " プログラム名")

		Call ExcelSetCell(MyBook, Target, 6, 3, "種別")
		Call ExcelRange(MyBook, Target, 6, 3, 6, 4 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 7, 3, "作成日")
		Call ExcelRange(MyBook, Target, 7, 3, 7, 4 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 8, 3, "作成者")
		Call ExcelRange(MyBook, Target, 8, 3, 8, 4 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 1, 5, " 項目名")

		Call ExcelSetCell(MyBook, Target, 3, 5, "型式")
		Call ExcelRange(MyBook, Target, 3, 5, 3, 5 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 4, 5, "桁数")
		Call ExcelRange(MyBook, Target, 4, 5, 4, 5 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 5, 5, "I/O")
		Call ExcelRange(MyBook, Target, 5, 5, 5, 5 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 6, 5, "種別")
		Call ExcelRange(MyBook, Target, 6, 5, 6, 5 )
		Call ExcelHAlign()

		For i = 6 to 25
			Call ExcelSetCell(MyBook, Target, 1, i, i - 5 )
			Call ExcelRange(MyBook, Target, 1, i, 1, i )
			Call ExcelHAlign()
		Next

	elseif Target = "出力設計書" then

		Call ExcelRange(MyBook, Target, 1, 1, 8, 38 )
		Call ExcelVAlign()

		Call ExcelSetCell(MyBook, Target, 1, 1, " システム名")

		Call ExcelSetCell(MyBook, Target, 3, 1, " サブシステム名")

		Call ExcelSetCell(MyBook, Target, 7, 1, " プログラムID")

		Call ExcelSetCell(MyBook, Target, 8, 1, "ページ")
		Call ExcelRange(MyBook, Target, 8, 1, 8, 1 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 8, 2, "/")
		Call ExcelRange(MyBook, Target, 8, 2, 8, 2 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 1, 3, " プログラム名")

		Call ExcelSetCell(MyBook, Target, 6, 3, "種別")
		Call ExcelRange(MyBook, Target, 6, 3, 6, 4 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 7, 3, "作成日")
		Call ExcelRange(MyBook, Target, 7, 3, 7, 4 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 8, 3, "作成者")
		Call ExcelRange(MyBook, Target, 8, 3, 8, 4 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 1, 5, " 列名")

		Call ExcelSetCell(MyBook, Target, 3, 5, " 更新説明")

		Call ExcelSetCell(MyBook, Target, 8, 5, "対象")
		Call ExcelRange(MyBook, Target, 8, 5, 8, 5 )
		Call ExcelHAlign()

		For i = 6 to 25
			Call ExcelSetCell(MyBook, Target, 1, i, i - 5 )
			Call ExcelRange(MyBook, Target, 1, i, 1, i )
			Call ExcelHAlign()
		Next

	end if

End Function

' ******************************************************
' ヘッダー,余白の指定
' ******************************************************
Function Format_Page(MyBook)

	on error resume next
	With MyBook.ActiveSheet.PageSetup
		.CenterHeader = "&18&A"
		.LeftMargin = ExcelApp.InchesToPoints(0.393700787401575)
		.RightMargin = ExcelApp.InchesToPoints(0.196850393700787)
		.TopMargin = ExcelApp.InchesToPoints(0.551181102362205)
		.BottomMargin = ExcelApp.InchesToPoints(0.393700787401575)
		.HeaderMargin = ExcelApp.InchesToPoints(0.196850393700787)
		.FooterMargin = ExcelApp.InchesToPoints(0.196850393700787)
	End With
	on error goto 0

End Function
</SCRIPT>
</JOB>


関連する記事

VBScript : Excel.Application でファイルを複数選択する




posted by lightbox at 2019-02-11 10:51 | VBS + オブジェクト | このブログの読者になる | 更新情報をチェックする

2019年02月10日


テーブル設計書作成 : VBScript + Excel.Application + SQLServer

※ 実行はコマンドプロンプトから、cscript table-spec.wsf として下さい。
※ Excel でテーブル設計書を作成する部分は他のデータベースでも可能ですが、それ用の SQL を考える必要があります。



table-spec.wsf
<JOB>
<RUNTIME>
<DESCRIPTION>
*******************************************************************
 プログラム名 : SQLServer 用表情報のレポート (複数実行)
*******************************************************************
</DESCRIPTION>
<EXAMPLE>

引数無し
</EXAMPLE>
</RUNTIME>

<COMMENT>
************************************************************
 対象テーブルリスト
************************************************************
</COMMENT>
<RESOURCE id="TableList">

社員マスタ
商品マスタ

</RESOURCE>

<COMMENT>
************************************************************
 オブジェクト定義
************************************************************
</COMMENT>
<REFERENCE object="ADODB.Connection" />
<OBJECT id="Cn" progid="ADODB.Connection" />
<OBJECT id="Rs" progid="ADODB.Recordset" />
<OBJECT id="ExcelApp" progid="Excel.Application" />
<OBJECT id="WshShell" progid="WScript.Shell" />
<OBJECT id="Fso" progid="Scripting.FileSystemObject" />

<COMMENT>
************************************************************
 外部スクリプト定義
************************************************************
</COMMENT>

<COMMENT>
************************************************************
 カレントスクリプト
************************************************************
</COMMENT>

<SCRIPT language=VBScript>

Dim str,strMessage,Target,strCurDir

' **********************************************************
' 作成される Excel ブック
' **********************************************************
Target = "table_spec_ss.xlsx"
strCurDir = WScript.ScriptFullName
strCurDir = Replace( strCurDir, WScript.ScriptName, "" )
Target = strCurDir & Target

Dim strSERVER,strDATABASE,strUSER,strPASS

' **********************************************************
' データベース接続情報
' **********************************************************
strSERVER = ".\sqlexpress"
strDATABASE = "lightbox"
strUSER = "sa"
strPASS = "password"

' **********************************************************
' コマンドプロンプトより起動される為の処理
' **********************************************************
str = WScript.FullName
str = Right( str, 11 )
str = Ucase( str )
if str <> "CSCRIPT.EXE" then
	strMessage = "コマンドプロンプトより cscript " & WScript.ScriptFullName
	strMessage = strMessage & " と指定して実行して下さい   " & vbCrLf & vbCrLf
	strMessage = strMessage & "( この文字列をクリップボードにコピーしたい場合は"
	strMessage = strMessage & " ctrl+c です )"
	WScript.Echo strMessage
	WScript.Quit
end if

' **********************************************************
' Excel 用定数
' **********************************************************
' https://docs.microsoft.com/ja-jp/dotnet/api/microsoft.office.interop.excel.xlpapersize?view=excel-pia
Const xlPaperB4 = 12

Const xlContinuous = 1
Const xlDash = -4115
Const xlDashDot = 4
Const xlDashDotDot = 5
Const xlDot = -4118
Const xlDouble = -4119
Const xlSlantDashDot = 13
Const xlLineStyleNone = -4142

Const xlHairline = 1
Const xlMedium = -4138
Const xlThick = 4
Const xlThin = 2

Const xlInsideHorizontal = 12
Const xlInsideVertical = 11
Const xlDiagonalDown = 5
Const xlDiagonalUp = 6
Const xlEdgeBottom = 9
Const xlEdgeLeft = 7
Const xlEdgeRight = 10
Const xlEdgeTop = 8

Const xlAutomatic = -4105

Const xlMaximized = -4137
Const xlMinimized = -4140
Const xlNormal = -4143

Const xlGeneral = 1
Const xlLeft = -4131
Const xlCenter = -4108
Const xlRight = -4152
Const xlFill = 5
Const xlJustify = -4130
Const xlCenterAcrossSelection = 7
Const xlDistributed = -4117
Const xlTop = -4160
Const xlBottom = -4107

Dim aTable,Result,Query,Query2,nCnt,strCol,aCol,nRows,nRowHeight
Dim MyBook,bAction,strSystemName,strSubName
Dim nColX,nColY,strSheetName,strBaseSheet
Dim aData

ExcelApp.Visible = False
strBaseSheet = "テーブル設計雛形"
strSystemName = "販売管理システム"
strSubName = "売上管理"
Query = "sp_columns "

' **********************************************************
' Excel 初期処理
' **********************************************************
aTable = Split( getResource("TableList"), vbCrLf )

' **********************************************************
' ブック作成
' **********************************************************
Set MyBook = CreateBook(Target)
if not IsObject( MyBook ) then
	' 初期処理エラーの為、直接終了
	ExcelApp.Quit
	' エラーメッセージの表示
	Wscript.Echo MyBook
	Wscript.Quit
end if

' **********************************************************
' DB 接続
' **********************************************************
Result = SQS_DBConnect( Cn, strSERVER, strDATABASE, strUSER, strPASS )
if Result <> "" then
	Wscript.Echo Result
	Wscript.Quit
end if

' **********************************************************
' 読み出し
' **********************************************************
Wscript.Echo "処理を開始しました。しばらくお待ち下さい"
bAction = False
For i = 0 to Ubound( aTable )
	if Trim( aTable(i) ) <> "" then
		if DBGet( Cn, Rs, Query & Ss( aTable(i) ), False ) then
			' ************************************************
			' Excel 処理
			' ************************************************
			nColX = 2
			nColY = 6
			if not bAction then
				bAction = True
				Call AddSheetLast( MyBook, strBaseSheet )
				Call DeleteSheet(MyBook,"Sheet1" )
				Call ColumnInit(MyBook,strBaseSheet)
				Wscript.Echo strBaseSheet & " を追加しました"
			end if
			strSheetName = ExcelCopySheet( MyBook, strBaseSheet, aTable(i) )
			strSaveSheetName = strSheetName
			Call ExcelSetCell(MyBook, strSheetName, 2, 2, strSystemName )
			Call ExcelSetCell(MyBook, strSheetName, 4, 2, strSubName )
			Call ExcelSetCell(MyBook, strSheetName, 10, 2, aTable(i) )
			Call ExcelSetCell(MyBook, strSheetName, 2, 4, aTable(i) )

			nCnt = 1
			nRowCnt = 1
			nSheetCount = 1
			Redim aData(0)
			Do While not Rs.EOF
				Redim Preserve aData(nCnt)
				aData(nCnt) = Rs.Fields("COLUMN_NAME").value & ""
				' ************************************************
				' Excel 処理
				' ************************************************
				Call ExcelSetCell(MyBook, strSheetName, nColX, nColY, Rs.Fields("COLUMN_NAME").value & "")
				Call ExcelSetCell(MyBook, strSheetName, nColX+2, nColY, Ucase(Rs.Fields("TYPE_NAME").value & "") )
				if Ucase( Rs.Fields("TYPE_NAME").value & "" ) = "VARCHAR" or _
					Ucase( Rs.Fields("TYPE_NAME").value & "" ) = "CHAR" or _
					Ucase( Rs.Fields("TYPE_NAME").value & "" ) = "NVARCHAR"or _ 
					Ucase( Rs.Fields("TYPE_NAME").value & "" ) = "NCHAR" then
					Call ExcelSetCell(MyBook, strSheetName, nColX+3, nColY, Rs.Fields("PRECISION").value & "")
				end if
				if Ucase( Rs.Fields("TYPE_NAME").value & "" ) = "DECIMAL" then
					Call ExcelSetCell(MyBook, strSheetName, nColX+3, nColY, Rs.Fields("PRECISION") & "")
					Call ExcelSetCell(MyBook, strSheetName, nColX+4, nColY, Rs.Fields("SCALE").value & "")
				end if
				nColY = nColY + 1

				Rs.MoveNext
				nCnt = nCnt + 1
				nRowCnt = nRowCnt + 1
				if nRowCnt > 65 then
					nRowCnt = 1
					nColX = 2
					nColY = 6
					nSheetCount = nSheetCount + 1
					strSheetName = ExcelCopySheet( MyBook, strBaseSheet, aTable(i) & "(" & nSheetCount & ")" )
					Call ExcelSetCell(MyBook, strSheetName, 2, 4, aTable(i) )
				end if
			Loop
			strSheetName = strSaveSheetName

			Result = ""
			Query2 = "sp_helpindex "
			if DBGet( Cn, Rs, Query2 & Ss( aTable(i) ), False ) then
				Do While not Rs.EOF
					if Left( Rs.Fields("index_name").value & "", 1 ) <> "_" then
						if InStr( Rs.Fields("index_description").value & "" , "primary key" ) > 0 then

							nCnt = 1
							strCol = Rs.Fields("index_keys").value & ""
							aCol = Split( strCol, ", " )

							For j = 0 to Ubound( aCol )
								For k = 1 to Ubound( aData )
									if aCol( j ) = aData( k ) then
										Call ExcelSetCell(MyBook, strSheetName, 11, 5 + k, j + 1 )
									end if
								Next
							Next

							Exit Do

						end if

					end if
					Rs.MoveNext
				Loop
			end if

			Wscript.Echo strSheetName & " を追加しました"
		end if
	end if

Next


' **********************************************************
' 接続解除
' **********************************************************
Call DBClose( Rs )
Call DBClose( Cn )

' **********************************************************
' 処理終了
' **********************************************************
Call ExcelSave(MyBook)
Call ExcelQuit(MyBook)

Wscript.Echo "処理が完了しました"

Call ExcelLoad(Target)


' **********************************************************
' Excel 出力用 初期処理
' **********************************************************
Function ColumnInit(MyBook,SheetName)

	' 行数
	nRows = 65
	nRowHeight = 13.5

	Call Format_Table(MyBook,SheetName)
	Call Format_Page(MyBook)

End Function

' **********************************************************
' Excel 処理関数
' **********************************************************
' ******************************************************
' シート名によるシート複写
' ******************************************************
Function ExcelCopySheet(MyBook, strSheetName, strNewSheetName)

	MyBook.Sheets(strSheetName).Copy (MyBook.Sheets(strSheetName))

	on error resume next
	MyBook.ActiveSheet.Name = strNewSheetName
	on error goto 0

	ExcelCopySheet = MyBook.ActiveSheet.Name

End Function

' ************************************************
' Excel ブック作成
' ************************************************
function CreateBook(BookPath)

	ExcelApp.DisplayAlerts = False

	ExcelApp.Workbooks.Add
	nBooks = ExcelApp.Workbooks.Count
	Set CreateBook = ExcelApp.Workbooks( nBooks )
	CreateBook.Activate

	on error resume next
	Call CreateBook.SaveAs( BookPath )
	if Err.Number <> 0 then
		CreateBook = "ERROR:" & Err.Description
	end if
	on error goto 0

End Function

' ******************************************************
' 終了
' ******************************************************
Function ExcelQuit(WorkBook)

	If TypeName(WorkBook) = "Workbook" Then
		' 保存した事にする
		WorkBook.Saved = True
	End If
	If IsObject(ExcelApp) Then
		ExcelApp.Quit
	End If

End Function

' ******************************************************
' セルへのデータセット
' ******************************************************
Function ExcelSetCell(MyBook, strSheetName, x, y, Data)

	MyBook.Sheets(strSheetName).Cells(y, x) = Data

End Function

' ******************************************************
' 先頭にシートを追加
' ******************************************************
function AddSheetTop( MyBook, SheetName )

	Dim Worksheet
	Dim Worksheet2

	Set Worksheet = MyBook.Worksheets( 1 )
	Worksheet.Activate
	Workbook.Worksheets.Add
	Set Worksheet2 = Workbook.ActiveSheet
	on error resume next
	Worksheet2.Name = SheetName
	on error goto 0

	AddSheetTop = Worksheet2.Name

end function

' ******************************************************
' 最後にシートを追加
' ******************************************************
function AddSheetLast( MyBook, SheetName )

	Dim Worksheet
	Dim Worksheet2
	Dim nSheets

	nSheets = MyBook.Worksheets.Count
	Set Worksheet = MyBook.Worksheets( nSheets )
	Worksheet.Activate
	Call MyBook.Worksheets.Add(,Worksheet)
	Set Worksheet2 = MyBook.ActiveSheet
	on error resume next
	Worksheet2.Name = SheetName
	on error goto 0

	AddSheetLast = Worksheet2.Name

end function

' ******************************************************
' Excel 実行 ( NT5.0 以上 )
' ******************************************************
Function ExcelLoad(strPath)

	Call WshShell.Run( "RunDLL32.EXE shell32.dll,ShellExec_RunDLL " & _
		strPath )

End Function

' ******************************************************
' 上書き保存
' ******************************************************
Function ExcelSave(MyBook)

	MyBook.Save

End Function

' ******************************************************
' シートを削除
' ******************************************************
function DeleteSheet( MyBook, SheetName )

	Dim Worksheet

	Set Worksheet = MyBook.Worksheets( SheetName )

	on error resume next
	Worksheet.Delete
	on error goto 0

end function

' ******************************************************
' 指定行の高さを設定
' ******************************************************
Function ExcelSetRowHeight(MyBook, strSheetName, row, Height)

	MyBook.Sheets(strSheetName).Rows(row).RowHeight = _
	Height

End Function

' ******************************************************
' 指定列の幅を設定
' ******************************************************
Function ExcelSetColumnWidth(MyBook, strSheetName, column, Width)

	Dim strColumn

	strColumn = Chr(Asc("A") + column - 1)

	MyBook.Sheets(strSheetName).Columns(strColumn).ColumnWidth = _
	Width

End Function

' ******************************************************
' 範囲選択
' ******************************************************
Function ExcelRange(MyBook, strSheetName, nX1, nY1, nX2, nY2 )

	Dim Sheet,strRange

	Set Sheet = MyBook.Sheets(strSheetName)
	Sheet.Select
	strRange = Chr(Asc("A") + nX1 - 1) & nY1 & ":"
	strRange = strRange & Chr(Asc("A") + nX2 - 1) & nY2
	Sheet.Range(strRange).Select

End Function

' ******************************************************
' 範囲の上に罫線
' ******************************************************
Function ExcelLine( nLineType, nWeight )

	With ExcelApp.Selection.Borders(xlEdgeTop)
		.LineStyle = nLineType
		.ColorIndex = xlAutomatic
		.Weight = nWeight
	End With

End Function

' ******************************************************
' 範囲の右に罫線(*追加*)
' ******************************************************
Function ExcelLineRight( nLineType, nWeight )

	With ExcelApp.Selection.Borders(xlEdgeRight)
		.LineStyle = nLineType
		.ColorIndex = xlAutomatic
		.Weight = nWeight
	End With

End Function

' ******************************************************
' 範囲に罫線
' ******************************************************
Function ExcelBox( nLineType, nWeight )

	With ExcelApp.Selection.Borders(xlEdgeTop)
		.LineStyle = nLineType
		.ColorIndex = xlAutomatic
		.Weight = nWeight
	End With
	With ExcelApp.Selection.Borders(xlEdgeLeft)
		.LineStyle = nLineType
		.ColorIndex = xlAutomatic
		.Weight = nWeight
	End With
	With ExcelApp.Selection.Borders(xlEdgeRight)
		.LineStyle = nLineType
		.ColorIndex = xlAutomatic
		.Weight = nWeight
	End With
	With ExcelApp.Selection.Borders(xlEdgeBottom)
		.LineStyle = nLineType
		.ColorIndex = xlAutomatic
		.Weight = nWeight
	End With

End Function

' ******************************************************
' 文字列の横位置を指定(*追加*)
' ******************************************************
Function ExcelHAlign()

	ExcelApp.Selection.HorizontalAlignment = xlCenterAcrossSelection

End Function
Function ExcelHAlign2()

	ExcelApp.Selection.HorizontalAlignment = xlCenter

End Function

' ******************************************************
' 文字列の縦位置を指定(*追加*)
' ******************************************************
Function ExcelVAlign()

	ExcelApp.Selection.VerticalAlignment = xlCenter

End Function

' ******************************************************
' シート名によるシート選択
' ******************************************************
Function ExcelSelectSheet(MyBook, strSheetName)

	MyBook.Sheets(strSheetName).Select

End Function

' ******************************************************
' テーブル設計書用フォーマット
' ******************************************************
Function Format_Table(MyBook,SheetName)

	'テーブル設計書フォーマット作成
	Call ExcelSelectSheet(MyBook, SheetName)
'	Call Format_Page(MyBook)

	Call ExcelSize_Table(MyBook, SheetName)
	Call ExcelLine_Table(MyBook, SheetName)
	Call ExcelSetText_Table(MyBook, SheetName)

End Function

' ******************************************************
' セルサイズの設定
' ******************************************************
Function ExcelSize_Table(MyBook, Target)

	Dim i

	'セルの高さ合わせ
	Call ExcelSetRowHeight(MyBook, Target, 1, 13.50)
	Call ExcelSetRowHeight(MyBook, Target, 2, 24.50)
	Call ExcelSetRowHeight(MyBook, Target, 3, 13.50)
	Call ExcelSetRowHeight(MyBook, Target, 4, 24.50)
	Call ExcelSetRowHeight(MyBook, Target, 5, 20.25)

	For i = 6 To nRows + 5
		Call ExcelSetRowHeight(MyBook, Target, i, nRowHeight)
	Next

	'セルの幅合わせ
	Call ExcelSetColumnWidth(MyBook, Target, 1, 3.50)
	Call ExcelSetColumnWidth(MyBook, Target, 2, 27.00)
	Call ExcelSetColumnWidth(MyBook, Target, 3, 0.75)
	Call ExcelSetColumnWidth(MyBook, Target, 4, 15.00)
	Call ExcelSetColumnWidth(MyBook, Target, 5, 4.50)
	Call ExcelSetColumnWidth(MyBook, Target, 6, 3.00)
	Call ExcelSetColumnWidth(MyBook, Target, 7, 0.75)
	Call ExcelSetColumnWidth(MyBook, Target, 8, 13.50)
	Call ExcelSetColumnWidth(MyBook, Target, 9, 0.75)
	Call ExcelSetColumnWidth(MyBook, Target, 10, 24.00)
	Call ExcelSetColumnWidth(MyBook, Target, 11, 12.00)

End Function

' ******************************************************
' 罫線の設定
' ******************************************************
Function ExcelLine_Table(MyBook, Target)

	Dim i

	' BOX罫線
	Call ExcelRange(MyBook, Target, 1, 1, 11, nRows + 5 )
	Call ExcelBox(xlContinuous, xlMedium)

	' 上罫線
	Call ExcelRange(MyBook, Target, 1, 2, 11, 2 )
	Call ExcelLine(xlDot, xlThin)

	Call ExcelRange(MyBook, Target, 1, 3, 11, 3 )
	Call ExcelLine(xlContinuous, xlThin)

	Call ExcelRange(MyBook, Target, 1, 4, 11, 4 )
	Call ExcelLine(xlDot, xlThin)

	Call ExcelRange(MyBook, Target, 1, 5, 11, 5 )
	Call ExcelLine(xlContinuous, xlMedium)

	Call ExcelRange(MyBook, Target, 1, 6, 11, 6 )
	Call ExcelLine(xlContinuous, xlMedium)

	for i = 7 to nRows + 5
		Call ExcelRange(MyBook, Target, 1, i, 11, i )
		Call ExcelLine(xlDot, xlThin)
	Next

	' 右罫線
	Call ExcelRange(MyBook, Target, 1, 6, 1, nRows + 5 )
	Call ExcelLineRight(xlDot, xlThin)

	Call ExcelRange(MyBook, Target, 2, 1, 2, 2 )
	Call ExcelLineRight(xlContinuous, xlThin)

	Call ExcelRange(MyBook, Target, 2, 5, 2, nRows + 5 )
	Call ExcelLineRight(xlContinuous, xlThin)

	Call ExcelRange(MyBook, Target, 4, 5, 4, nRows + 5 )
	Call ExcelLineRight(xlContinuous, xlThin)

	Call ExcelRange(MyBook, Target, 5, 6, 5, nRows + 5 )
	Call ExcelLineRight(xlDot, xlThin)

	Call ExcelRange(MyBook, Target, 6, 3, 6, nRows + 5 )
	Call ExcelLineRight(xlContinuous, xlThin)

	Call ExcelRange(MyBook, Target, 8, 1, 8, 4 )
	Call ExcelLineRight(xlContinuous, xlThin)

	Call ExcelRange(MyBook, Target, 10, 1, 10, nRows + 5 )
	Call ExcelLineRight(xlContinuous, xlThin)

End Function

' ******************************************************
' セルのテキストの設定
' ******************************************************
Function ExcelSetText_Table(MyBook, Target)

	Dim i

	Call ExcelRange(MyBook, Target, 1, 1, 7, 49 )
	Call ExcelVAlign()

	' 1行目
	Call ExcelSetCell(MyBook, Target, 1, 1, " システム名")

	Call ExcelSetCell(MyBook, Target, 3, 1, " サブシステム名")

	Call ExcelSetCell(MyBook, Target, 9, 1, " テーブルID")
	Call ExcelRange(MyBook, Target, 9, 1, 10, 1 )
	Call ExcelHAlign()
	Call ExcelRange(MyBook, Target, 9, 2, 10, 1 )
	Call ExcelVAlign()

	Call ExcelSetCell(MyBook, Target, 11, 1, "ページ")
	Call ExcelRange(MyBook, Target, 11, 1, 11, 1 )
	Call ExcelHAlign()
	Call ExcelRange(MyBook, Target, 11, 2, 11, 2 )
	Call ExcelHAlign()
	Call ExcelRange(MyBook, Target, 11, 2, 11, 2 )
	Call ExcelVAlign()

	' 2行目
	Call ExcelSetCell(MyBook, Target, 11, 2, "/")
	Call ExcelRange(MyBook, Target, 11, 2, 11, 2 )

	' 3行目
	Call ExcelSetCell(MyBook, Target, 1, 3, " テーブル名")

	Call ExcelSetCell(MyBook, Target, 7, 3, "種別")
	Call ExcelRange(MyBook, Target, 7, 3, 8, 3 )
	Call ExcelHAlign()

	Call ExcelSetCell(MyBook, Target, 9, 3, "作成日")
	Call ExcelRange(MyBook, Target, 9, 3, 10, 3 )
	Call ExcelHAlign()

	Call ExcelSetCell(MyBook, Target, 11, 3, "作成者")
	Call ExcelRange(MyBook, Target, 11, 3, 11, 3 )
	Call ExcelHAlign()

	' 4行目
	Call ExcelRange(MyBook, Target, 8, 4, 8, 4 )
	Call ExcelHAlign2()
	Call ExcelVAlign()

	Call ExcelRange(MyBook, Target, 10, 4, 10, 4 )
	Call ExcelHAlign2()
	Call ExcelVAlign()

	Call ExcelRange(MyBook, Target, 11, 4, 11, 4 )
	Call ExcelHAlign2()
	Call ExcelVAlign()

	' 5行目
	Call ExcelSetCell(MyBook, Target, 1, 5, " 列名")

	Call ExcelSetCell(MyBook, Target, 3, 5, "データ型")
	Call ExcelRange(MyBook, Target, 3, 5, 4, 5 )
	Call ExcelHAlign()

	Call ExcelSetCell(MyBook, Target, 5, 5, "サイズ")
	Call ExcelRange(MyBook, Target, 5, 5, 6, 5 )
	Call ExcelHAlign()

	Call ExcelSetCell(MyBook, Target, 7, 5, " 説明")

	Call ExcelSetCell(MyBook, Target, 11, 5, "主キー")
	Call ExcelRange(MyBook, Target, 11, 5, 11, 5 )
	Call ExcelHAlign()
	Call ExcelVAlign()

	for i = 6 to nRows + 5
		Call ExcelSetCell(MyBook, Target, 1, i, i - 5)
		Call ExcelRange(MyBook, Target, 1, i, 1, i )
		Call ExcelHAlign()
		Call ExcelRange(MyBook, Target, 11, i, 11, i )
		Call ExcelHAlign()
	next

	Call ExcelRange(MyBook, Target, 1, 1, 1, 1 )

End Function

' ******************************************************
' ヘッダー,余白の指定
' ******************************************************
Function Format_Page(MyBook)

	on error resume next

	With MyBook.ActiveSheet.PageSetup
		.CenterHeader = "&18&A"
		.PaperSize = xlPaperB4
'		.LeftMargin = ExcelApp.InchesToPoints(0.393700787401575)
'		.RightMargin = ExcelApp.InchesToPoints(0.196850393700787)
'		.TopMargin = ExcelApp.InchesToPoints(0.551181102362205)
'		.BottomMargin = ExcelApp.InchesToPoints(0.393700787401575)
'		.HeaderMargin = ExcelApp.InchesToPoints(0.196850393700787)
'		.FooterMargin = ExcelApp.InchesToPoints(0.196850393700787)
	End With

	on error goto 0

End Function

' ******************************************************
' シングルクォートで囲む
' ******************************************************
Function Ss( strValue )

	Ss = "'" & strValue & "'"

End Function

' ******************************************************
' DB接続(SQLServer)
' ******************************************************
Function SQS_DBConnect( _
	Connection, _
	Server, _
	DB, _
	User, _
	Pass _
)

	Dim ConnectionString

	ConnectionString = _
		"Provider=SQLOLEDB;" & _
		"Data Source=" & Server & ";" & _
		"Initial Catalog=" & DB & ";" & _
		"User ID=" & User & ";" & _
		"Password=" & Pass & ";"
	
	if IsEmpty( Connection ) then
		Set Connection = CreateObject( "ADODB.Connection" )
	end if

	on error resume next
	Connection.Open ConnectionString
	if Err.Number <> 0 then
		SQS_DBConnect = "ERROR:" & Err.Description
	else
		SQS_DBConnect = ""
	end if
	on error goto 0

End Function

' ******************************************************
' DB終了処理(接続を閉じる)
' ******************************************************
Function DBClose( _
	CnRs _
)
	
	On Error Resume Next
	If CnRs.State >= 1 Then
		CnRs.Close
	End If
	On Error Goto 0

	DBClose = True

End Function

' ******************************************************
' DB読込み
' 【戻り値】: True(データ有り),False(データ無し)
' ******************************************************
Function DBGet( _
	Connection, _
	Record, _
	SqlQuery, _
	bUpadateFlg _
)
	if IsEmpty( Record ) then
		Set Record = CreateObject( "ADODB.Recordset" )
	end if

	Dim ConstCheck

	' 閉じていない時は閉じる
	If Record.State >= 1 Then
		Record.Close
	End If

	' 更新処理に使用する場合は、レコード単位の共有的ロック
	If bUpadateFlg Then
		ConstCheck = adLockOptimistic
		if IsEmpty( ConstCheck ) then
			Record.LockType = 3
		else
			Record.LockType = adLockOptimistic
		end if
	else
		ConstCheck = adLockOptimistic
		if IsEmpty( ConstCheck ) then
			Record.LockType = 1
		else 
			Record.LockType = adLockReadOnly
		end if
	End If
	
	' レコードセット作成
	Record.Open SqlQuery, Connection
	If Record.State >= 1 Then
		If Record.EOF Then
			DBGet = False
		Else
			DBGet = True
		End If
	else
		DBGet = False
	end if

End Function

</SCRIPT>
</JOB>


関連する記事

VBScript : Excel.Application でファイルを複数選択する




posted by lightbox at 2019-02-10 19:44 | VBS + オブジェクト | このブログの読者になる | 更新情報をチェックする
container 終わり

フリーフォントで簡単ロゴ作成
フリーフォントでボタン素材作成
フリーフォントで吹き出し画像作成
フリーフォントではんこ画像作成
ほぼ自由に利用できるフリーフォント
フリーフォントの書体見本とサンプル
画像を大きく見る為のウインドウを開くボタンの作成

CSS ドロップシャドウの参考デモ
イラストAC
ぱくたそ
写真素材 足成
フリーフォント一覧
utf8 文字ツール
右サイド 終わり
base 終わり