我为excel编写了一个宏,用于Aspen中的模拟。宏工作得很好,除了一部分不能正常工作。我现在不是为什么而是
部分For j = 0 To 1
Call Run
Next j
Sub Start()
中的未正确执行。由于for循环显示Call Run
应该执行两次。但事实并非如此。当我运行Sub Start()时它可以工作,但Call Run
只执行一次。这里是VB中宏的完整代码。我会对任何建议表示感谢。
Option Explicit
Dim na As Integer
Dim nb As Integer
Dim nc As Integer
'Dim nd As Integer
Dim i As Integer
Dim j As Integer
'Dim B As Integer
'Dim B As Double
Dim nresults As Integer
Dim Index1 As Integer
Dim Resultfile As String
Dim Resultfolder As String
Dim nlaeufe As Integer
Dim NewBook As Object
Dim ACMObj As Object
Dim nDaten As Integer
Sub Start()
Application.ActiveWorkbook.Save
nlaeufe = Sheet0.Cells(2, 2)
Call Clear_Data
For i = 0 To nlaeufe
'Sheet0.Cells(3, 2) = nlaeufe - i
Set ACMObj = GetObject(Sheet0.Cells(1, 2))
Application.DisplayAlerts = False
ACMObj.Application.Visible = True
Call Count_Daten
Call Add_Daten(ACMObj, nDaten)
For j = 0 To 2
Call Run
Next j
Call Get_Data
If ACMObj.Application.Simulation.State <> "Running" Then
Call Results_newfile
Application.ActiveWorkbook.Save
End If
Next i
End Sub
Sub Get_Data()
' If Sheet0.Cells(Index1 - 1, 2).Value <> ACMObj.Application.Simulation.Time Then
'Sheet0.Cells(Index1, 2).Value = ACMObj.Application.Simulation.Time
Dim nd
For nd = 0 To 152
Sheet0.Cells(32 + nd, 4 + i).Value = ACMObj.Flowsheet.Resolve(Sheet0.Cells(32 + nd, 2)).Value
Sheet0.Cells(187 + nd, 4 + i).Value = ACMObj.Flowsheet.Resolve(Sheet0.Cells(187 + nd, 2)).Value
Next nd
'Index1 = Index1 + 1
'If RunStatus = 1 Then _
' Application.OnTime Now + Sheet0.Cells(4, 2).Value, "Get_Data"
'Else
'End If
End Sub
Sub Count_Daten()
Dim na
While Sheet0.Cells(6 + na, 4) <> ""
na = na + 1
Wend
nDaten = na - 1
End Sub
Sub Add_Daten(ACMObj, nDaten)
Dim nb
Dim B
For nb = 1 To nDaten
Set B = ACMObj.Application.Simulation.Flowsheet.Resolve(CStr(Sheet0.Cells(6 + nb, 3)))
B.Value = Sheet0.Cells(6 + nb, 4 + i).Value
Next nb
End Sub
Sub Run()
Set ACMObj = GetObject(Sheet0.Cells(1, 2))
Application.DisplayAlerts = False
ACMObj.Application.Visible = True
ACMObj.Application.Simulation.runmode = "Steady State"
On Error Resume Next ' In case we are already running
ACMObj.Run (False)
End Sub
Sub Results_newfile()
Resultfolder = Sheet0.Cells(1, 8)
Resultfile = Sheet0.Cells(2, 8)
' Set NewBook = Workbooks.Add(xlWBATWorksheet)
'NewBook.SaveAs (Resultfolder & Resultfile & ".xls")
'NewBook.Activate
'ThisWorkbook.Activate
Sheet0.Select
Range("A1:BA65536").Select
Selection.Copy
' NewBook.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Call Copy_figure
'NewBook.Save
ThisWorkbook.Activate
End Sub
Sub Clear_Data()
Dim i As Integer
Dim nc As Integer
'i = 100
Sheet0.Select
Range("C32:HH166").Select
Selection.Clear
While Sheet0.Cells(32 + nc, 3) <> ""
'Range(Cells(32 + i, 2), Cells(182 + i, 53)).Select
nc = nc + 152
Selection.Clear
i = i + 152
Wend
Range("A1").Select
End Sub
答案 0 :(得分:0)
您有自动展示广告和“错误恢复下一次”声明,之后都没有“关闭”。
如果你暂时禁用这些,它会给你任何错误信息或其他可能发生的事情的指示吗?