'Begin Description '正規乱数変数生成スクリプト 2007/2/26 k.hori '変数の数とサンプルサイズを指定してOK 'End Description Sub Main Begin Dialog UserDialog 350,133,"正規乱数生成",.DialogFunc ' %GRID:10,7,1,1 TextBox 190,14,110,21,.nvar TextBox 190,49,110,21,.n OKButton 60,98,80,21,.OK CancelButton 190,98,100,21,.Cancel Text 40,21,100,14,"変数の数",.t1 Text 40,56,130,14,"サンプルサイズ",.t2 End Dialog Dim dlg As UserDialog Dialog dlg Debug.Print Dialog(dlg) End Sub Function DialogFunc%(DlgItem$, Action%, SuppValue%) Debug.Print "Action=";Action% Debug.Print "SuppValue=";SuppValue% Select Case Action% Case 0 'キャンセルボタン Debug.Print "textbox1";DlgText("nvar") Case 1 ' Dialog box初期化 Beep Case 2 ' Value changing or button pressed If DlgItem$ = "OK" Then If Not(IsItInteger(DlgText("nvar"))) Then MsgBox("変数の数は正の整数でなければいけません!",vbOkOnly) Else If Not(IsItInteger(DlgText("n"))) Then MsgBox("サンプルサイズは正の整数でなければいけません!",vbOkOnly) End If End If Call execcommand(DlgText("nvar"),DlgText("n")) End End If Case 4 ' Focus changed Debug.Print "DlgFocus=""";DlgFocus();"""" Case 5 'アイドリング End Select End Function Function IsItInteger(a)As Boolean If Not(IsNumeric(a)) Then MsgBox "正の整数を使用してください" IsItInteger=False Exit Function End If IsItInteger = (CDbl(a)>0 And CDbl(a)=Int(a)) End Function Sub execcommand(nvar,n) 'マクロ命令記述部 ********************************************. Dim strCommand As String Call macrocompile() strCommand = "ransu nvar="+nvar+" /nsmpl= "+n &vbCrLf 'macro が単純なら前で指定するだけでいい strCommand = strCommand + "." &vbCrLf objSpssApp.ExecuteCommands strCommand , False End Sub Sub macrocompile() Dim strCommand As String strCommand = strCommand + "*乱数生成マクロ." &vbCrLf strCommand = strCommand + "define ransu (nvar=!charend('/')/" &vbCrLf strCommand = strCommand + "nsmpl=!charend('/')" &vbCrLf strCommand = strCommand + ")." &vbCrLf strCommand = strCommand + "new file." &vbCrLf strCommand = strCommand + "input program." &vbCrLf strCommand = strCommand + "vector v(!nvar)." &vbCrLf strCommand = strCommand + "loop #i=1 to !nsmpl." &vbCrLf strCommand = strCommand + "+ loop #j = 1 to !nvar." &vbCrLf strCommand = strCommand + "+ compute v(#j)=normal(1)." &vbCrLf strCommand = strCommand + "+ end loop." &vbCrLf strCommand = strCommand + "+ end case." &vbCrLf strCommand = strCommand + "end loop." &vbCrLf strCommand = strCommand + "end file." &vbCrLf strCommand = strCommand + "end input program." &vbCrLf strCommand = strCommand + "exec." &vbCrLf strCommand = strCommand + "!enddefine." &vbCrLf objSpssApp.ExecuteCommands strCommand , False End Sub