2020年02月02日


VBScript(PHP) で氏名をランダムに作成





names.wsf
<JOB>
<COMMENT>
************************************************************
 WEB WSH 実行スケルトン
************************************************************
</COMMENT>

<OBJECT id="WshShell" progid="WScript.Shell" />

<SCRIPT language=VBScript>
' ***********************************************************
' 処理開始
' ***********************************************************

nMax = 500

' ***********************************************************
' Cscript.exe で強制実行
' ***********************************************************
Crun

strName1 = "山川森鈴木高田本多村吉岡松丸杉浦中尾安原野内"
strName2 = "和元雅正由克友浩春冬洋輝"
strName3 = "男也一行樹之"
strName4 = "子代美恵"

str = ""

For i = 1 to nMax
	' 姓1文字目
	nTarget = Random( 1, Len(strName1) )
	strName = Mid( strName1, nTarget, 1 )
	' 1文字目と2文字目が一致したら除外
	nTarget2 = nTarget
	Do while( nTarget = nTarget2 )
		nTarget2 = Random( 1, Len(strName1) )
	Loop
	' 姓2文字目
	strName = strName & Mid( strName1, nTarget2, 1 ) & " "
	' 名1文字目
	nTarget = Random( 1, Len(strName2) )
	strName = strName & Mid( strName2, nTarget, 1 )
	' 性別
	nTarget = Random( 0, 1 )
	' 性別によって名2文字目を決定
	if nTarget = 0 then
		nTarget = Random( 1, Len(strName3) )
		strName = strName & Mid( strName3, nTarget, 1 )
	else
		nTarget = Random( 1, Len(strName4) )
		strName = strName & Mid( strName4, nTarget, 1 )
	end if

	str = str & strName & " / "
	if (i-1) Mod 6 = 5 then
		Wscript.Echo str
		str = ""
	end if

Next

if str <> "" then
	Wscript.Echo str
end if


REM ************************************************
REM 指定範囲の整数の乱数を取得
REM ************************************************
Function Random( nMin, nMax )

	Randomize
	Random = nMin + Int(Rnd * (nMax - nMin + 1))

End function

Function SameRandom( nMin, nMax )

	SameRandom = nMin + Int(Rnd * (nMax - nMin + 1))

End function

REM **********************************************************
REM Wscript で実行された場合は Cscript で実行しなおす
REM **********************************************************
Function Crun( )

	Dim str

	str = WScript.FullName
	str = Right( str, 11 )
	str = Ucase( str )
	if str <> "CSCRIPT.EXE" then
		str = WScript.ScriptFullName
		strParam = " "
		For I = 0 to Wscript.Arguments.Count - 1
			if instr(Wscript.Arguments(I), " ") < 1 then
				strParam = strParam & Wscript.Arguments(I) & " "
			else
				strParam = strParam & Dd(Wscript.Arguments(I)) & " "
			end if
		Next
		Call WshShell.Run( "cmd.exe /c cscript.exe " & Dd(str) & strParam & " & pause", 3 )
		WScript.Quit
	end if

End Function

REM **********************************************************
REM ダブルクォートで囲む
REM **********************************************************
Function Dd( strValue )

	Dd = """" & strValue & """"

End function

</SCRIPT>
</JOB>


names.php
<?php
// ソースコードは UTF8N
// PHP.INI の default_charset = "UTF-8"

$NAME_1 = 0;
$NAME_2 = 1;
$NAME_3 = 2;
$NAME_4 = 3;

# シード
$name_seed = array();
$name_seed[] = "山川森鈴木高田本多村吉岡松丸杉浦中尾安原野内";
$name_seed[] = "和元雅正由克友浩春冬洋輝";
$name_seed[] = "男也一行樹之";
$name_seed[] = "子代美恵";
$names = array();

# 人数
$num = 100;

for ( $i = 0; $i < $num; $i++ ) {

	// 姓1文字目
	$n1 = mb_substr( $name_seed[$NAME_1], rand( 0, mb_strlen($name_seed[$NAME_1])-1 ), 1 );

	// 1文字目と2文字目が一致したら除外
	$n2 = $n1;
	while( $n2 == $n1 ) {
		$n2 = mb_substr( $name_seed[$NAME_1], rand( 0, mb_strlen($name_seed[$NAME_1])-1 ), 1 ) ;
	} 

	
	$name_result = $n1 . $n2 . " ";

	// 名1文字目
	$n3 = mb_substr( $name_seed[$NAME_2], rand( 0, mb_strlen($name_seed[$NAME_2])-1 ), 1 );
	$name_result .= $n3;

	$sex = rand( 0,1 );

	// 性別によって名2文字目を決定
	if ( $sex == 0 ) {
		$name_result .= mb_substr( $name_seed[$NAME_3], rand( 0, mb_strlen($name_seed[$NAME_3])-1 ), 1 );
	}
	else {
		$name_result .= mb_substr( $name_seed[$NAME_4], rand( 0, mb_strlen($name_seed[$NAME_4])-1 ), 1 );
	}

	// php PHP 7.3.13 で化けません
	if ( array_search( $name_result, $names ) === FALSE ) {
		print $name_result;
	}
	else {
		// 同姓同名
		print "*" . $name_result;
	}

	print " / ";

	if ( $i % 6 == 5 ) {
		print "\n";
	}

	$names[] = $name_result;

}

file_put_contents("names.log", print_r($names, true) );

print "\n";
print file_get_contents("names.log");

?>


▼ names.bat
php.exe "%~p0names.php"
pause








posted by at 2020-02-02 15:22 | サンプル | このブログの読者になる | 更新情報をチェックする

2010年03月27日


VBScript : Excel2007 のグラフ作成

Excel_chart

Microsoft のサンプルと全く同じでは動きませんでしたので、マクロを記録して
コードを補完しました。
Cells で、行・カラムにしているのはそのほうがプログラミングで都合がいいからです

関連する記事

PowerShell2.0 : COM 経由で Excel のグラフを作成した後、PDFとしてエクスポートする


<JOB>
<SCRIPT
	language="VBScript"
	src="http://lightbox.on.coocan.jp/webwsh/GetScriptDir.vbs"
></SCRIPT>

<SCRIPT language=VBScript>
' ***********************************************************
' 新しいグラフを作成する
' ***********************************************************

Dim ExcelApp	' アプリケーション
Dim ExcelBook	' ブック
Dim MySheet
Dim dataRange
Dim chartObjects
Dim newChartObject
Dim MyChart
Dim BookPath

Set ExcelApp = CreateObject("Excel.Application")

' 警告を出さないようにする
ExcelApp.DisplayAlerts = False
' Excel を表示状態にする
'ExcelApp.Visible = True

' ブック追加
ExcelApp.Workbooks.Add

' 追加したブックを取得
Set ExcelBook = ExcelApp.Workbooks( ExcelApp.Workbooks.Count )

' Worksheet を選択 ( 最初のシート )
Set MySheet = ExcelBook.Sheets(1)

' シートへグラフ用データをセット
MySheet.Cells(1, 1) = ""
MySheet.Cells(1, 2) = "Q1"
MySheet.Cells(1, 3) = "Q2"
MySheet.Cells(1, 4) = "Q3"
MySheet.Cells(1, 5) = "Q4"

MySheet.Cells(2, 1) = "N. America"
MySheet.Cells(2, 2) = "1.5"
MySheet.Cells(2, 3) = "2"
MySheet.Cells(2, 4) = "1.5"
MySheet.Cells(2, 5) = "2.5"

MySheet.Cells(3, 1) = "S. America"
MySheet.Cells(3, 2) = "2"
MySheet.Cells(3, 3) = "1.75"
MySheet.Cells(3, 4) = "2"
MySheet.Cells(3, 5) = "2"
 
MySheet.Cells(4, 1) = "Europe"
MySheet.Cells(4, 2) = "2.25"
MySheet.Cells(4, 3) = "2"
MySheet.Cells(4, 4) = "2.5"
MySheet.Cells(4, 5) = "2"

 
MySheet.Cells(5, 1) = "Asia"
MySheet.Cells(5, 2) = "2.5"
MySheet.Cells(5, 3) = "2.5"
MySheet.Cells(5, 4) = "2"
MySheet.Cells(5, 5) = "2.75"

' データの範囲
Set dataRange = MySheet.Range(MySheet.Cells(1, 1), MySheet.Cells(5, 5))

Set chartObjects = MySheet.ChartObjects()
' 座標は、グラフのエリア
Set newChartObject = chartObjects.Add(0, 100, 300, 300)

Dim paramChartFormat : paramChartFormat = 1
Dim paramCategoryLabels : paramCategoryLabels = 0
Dim paramSeriesLabels : paramSeriesLabels = 0
Dim paramHasLegend  : paramHasLegend = True
Dim paramTitle : paramTitle = "Sales by Quarter"
Dim paramCategoryTitle : paramCategoryTitle = "Fiscal Quarter"
Dim paramValueTitle : paramValueTitle = "Billions"

Set MyChart = newChartObject.Chart

MyChart.ChartType = 54
Call MyChart.SetSourceData( dataRange )

BookPath = GetScriptDir & "\chart.xls"
on error resume next
' 保存
' 56 は、Excel 2007 で拡張子 .xls で保存する場合に必要
if CLng(Left(ExcelApp.Version & "",2 )) > 11 then
	Call ExcelBook.SaveAs( BookPath, 56 )
else
	Call ExcelBook.SaveAs( BookPath )
end if
if Err.Number <> 0 then
	MsgBox( "ERROR:" & Err.Description )
end if
on error goto 0

' Excel をアプリケーションとして終了
ExcelApp.Quit
' Excel を VBScript から開放
Set ExcelApp = Nothing
' オブジェクト変数を通常変数として初期化
ExcelApp = Empty


</SCRIPT>
</JOB>

関連する記事

VBScript : 実行中のスクリプトが存在するディレクトリ
VBScript : Excel の新しいBookを作成する


関連する Microsoft ドキュメント

Creating Basic Column Charts in Excel 2007
XlChartType Enumeration [Excel 2007 Developer Reference]


タグ:EXCEL VBScript
posted by at 2010-03-27 14:51 | サンプル | このブログの読者になる | 更新情報をチェックする

2010年03月26日


VBScript : Excel のバージョン表示

何故か、Version プロパティは文字列で返されて来るのに、
.0 という部分が付加されています。2007のExcel のバージ
ョン表示を見ると、その .0 の部分も表示されています。
(以前のバージョンでは表示されていなかったと思います)

全てを表示するのであれば、ExcelApp.Version と ExcelApp.Build
をそのまま表示すれば良いですが、バージョン毎の動作の違いの為
に使う場合は、CLng(Left(ExcelApp.Version & "",2 )) として
使うと良いと思います。
Excel2007_version
Set ExcelApp = CreateObject("Excel.Application")

MsgBox( CLng(Left(ExcelApp.Version & "",2 ))&"."&ExcelApp.Build  )


' Excel をアプリケーションとして終了
ExcelApp.Quit
' Excel を VBScript から開放
Set ExcelApp = Nothing
' オブジェクト変数を通常変数として初期化
ExcelApp = Empty




タグ:VBScript EXCEL
posted by at 2010-03-26 09:16 | サンプル | このブログの読者になる | 更新情報をチェックする

2009年06月10日


VBScript : テキストファイルの行入出力

' **********************************************************
' テキストファイルの1行単位での入出力
' **********************************************************

Set Fso = CreateObject( "Scripting.FileSystemObject" )

strPath1 = "enum_desktop.vbs"
strPath2 = "enum_desktop.txt"

Set objHandle1 = Fso.OpenTextFile( strPath1, 1 )
Set objHandle2 = Fso.OpenTextFile( strPath2, 2, True )

Do While not objHandle1.AtEndOfStream
	Buffer = objHandle1.ReadLine
	objHandle2.WriteLine Buffer
Loop

Call objHandle2.Close()
Call objHandle1.Close()

posted by at 2009-06-10 21:29 | サンプル | このブログの読者になる | 更新情報をチェックする

VBScript : テキストファイルの一括入出力

' **********************************************************
' メモリを使用したテキストファイルの一括入出力
' **********************************************************

Set Fso = CreateObject( "Scripting.FileSystemObject" )

strPath1 = "enum_desktop.vbs"
strPath2 = "enum_desktop.txt"

Set objHandle1 = Fso.OpenTextFile( strPath1, 1 )
Set objHandle2 = Fso.OpenTextFile( strPath2, 2, True )

strText = objHandle1.ReadAll
objHandle2.Write( strText )

Call objHandle2.Close()
Call objHandle1.Close()

OpenTextFile

posted by at 2009-06-10 18:48 | サンプル | このブログの読者になる | 更新情報をチェックする
×

この広告は180日以上新しい記事の投稿がないブログに表示されております。