我已经为excel编写了一个宏,用于在Aspen中进行模拟。宏工作得很好,除了一部分不能正常工作

时间:2011-02-05 16:28:59

标签: excel vba

我为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

1 个答案:

答案 0 :(得分:0)

您有自动展示广告和“错误恢复下一次”声明,之后都没有“关闭”。

如果你暂时禁用这些,它会给你任何错误信息或其他可能发生的事情的指示吗?