Question

目前我正在使用Arena Simulation进行一个acadamic项目。我想通过VBA启动acadamic Arena版本的模型，运行模型并自动关闭它。

到目前为止，Arena模型已打开但未运行。在竞技场中单击运行按钮（以启动模型模拟）是缺失的。我怎样才能点击＆＃34; VBA中的运行按钮？

我目前的代码部分：

Private Function ExecuteArena(ByVal arenaFile As String, ByVal arenaPath As String)

On Error GoTo ErrorHandler

''' Clear the error mesaage variable.
gszErrMsg = vbNullString

''' Shell out
If Not bShellAndWait(arenaPath & " " & arenaFile & " ", 6) Then Err.Raise 9999

Exit Function

ErrorHandler:
''' If we ran into any errors this will explain what they are.
MsgBox gszErrMsg, vbCritical, "Shell and Wait Error"

End Function

   Private Function bShellAndWait(ByVal szCommandLine As String, Optional ByVal iWindowState As Integer = vbHide) As Boolean
Dim lTaskID As Long
Dim lProcess As Long
Dim lExitCode As Long 
Dim lResult As Long

On Error GoTo ErrorHandler

''' Run the Shell function.
lTaskID = Shell(szCommandLine, iWindowState)

''' Check for errors.
If lTaskID = 0 Then Err.Raise 9999, , "Shell function error."

''' Get the process handle from the task ID returned by Shell.
lProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0&, lTaskID)

''' Check for errors.
If lProcess = 0 Then Err.Raise 9999, , "Unable to open Shell process handle."

''' Loop while the shelled process is still running. 
Do
 ''' lExitCode will be set to STILL_ACTIVE as long as the shelled process is running.
 lResult = GetExitCodeProcess(lProcess, lExitCode)
 DoEvents
Loop While lExitCode = STILL_ACTIVE

bShellAndWait = True
Exit Function

ErrorHandler:
 gszErrMsg = Err.Description
 bShellAndWait = False
End Function

Answer 1

我找到了问题的答案。首先，您必须在VBA中激活Arena Libary。额外 - ＆GT;参考 - ＆GT;选择“Arena 14.0 Type Library”。然后，您可以使用此代码打开，运行和结束竞技场模型。

'Declare variables
Dim oArenaApp As Arena.Application
Dim oModel As Arena.Model, oSIMAN As Arena.SIMAN
Dim oModule As Arena.Module

'Start Arena, open model, make Arena active & visible
Set oArenaApp = CreateObject("Arena.Application")
ModName = "YOUR FILEPATH"
Set oModel = oArenaApp.Models.Open(ModName)
Set oSIMAN = oModel.SIMAN
oArenaApp.Activate
oArenaApp.Visible = True

'Run model in batch mode and send results back to Excel
oModel.BatchMode = True ' Turn off animation
oModel.QuietMode = True ' Do not ask final question
oModel.Go (smGoWait) ' Suspend VB until run ends    

'End model run and exit Arena
oModel.End
oArenaApp.Visible = False

竞技场模拟在VBA中启动和关闭

1 个答案: