我有这个脚本,我正在努力,而且我已经完成了它,但是有一个小问题。我得到常见的Excel.exe在任务管理器问题中挥之不去,并且很难解决它。下面的代码工作正常,直到我添加标记为“工作表输入”的行。我想要做的是将来自PC DMIS程序(Excel外部)的数据路由到基于操作员输入框的单独工作表。如果我取出我添加的行(工作表输入),它运行正常,Excel就像它应该关闭,所以我猜我在那几行中的某处出了点问题。根据我所做的阅读时间,看来我正在以某种方式孤立一个物体。我是在正确的轨道上,还是我需要查看其他内容?
Sub Main
'xl Declarations
Dim xlApp As Object
Dim xlWorkbooks As Object
Dim xlWorkbook As Object
Dim xlSheet As Object
Dim count As Integer
Dim xlWorksheets As String
Dim xlWorksheet As String
'pcdlrn declarations And Open ppg
Dim App As Object
Set App = CreateObject("PCDLRN.Application")
Dim Part As Object
Set Part = App.ActivePartProgram
Dim Cmds As Object
Set Cmds = Part.Commands
Dim Cmd As Object
Dim DCmd As Object
Dim DcmdID As Object
Dim fs As Object
Dim DimID As String
Dim ReportDim As String
Dim CheckDim As String
Dim myValue As String
Dim message, title, defaultValue As String
message = "Cavity"
title = "cavity"
defaultValue = "1"
myValue = InputBox(message, title, defaultValue)
If myValue = "" Then myValue = defaultValue
'Check To see If results file exists
FilePath = "C:\Excel PC DMIS\3K170 B2A\"
Set fs = CreateObject("Scripting.FileSystemObject")
ResFileExists = fs.fileexists(FilePath & Part.partname & ".xls")
'Open Excel And Base form
Set xlApp = CreateObject("Excel.Application")
Set xlWorkbooks = xlapp.Workbooks
If ResFileExists = False Then
TempFilename = FilePath & "Loop Template.xls"
Else
TempFilename = FilePath & Part.partname & ".xls"
End If
Set xlWorkbook = xlWorkbooks.Open(TempFilename)
Set xlSheet = xlWorkbook.Worksheets("Sheet1")
Set xlsheets = xlworkbook.worksheets ‘start worksheet input
Dim sh As Worksheet, flg As Boolean
For Each sh In xlworkbook.worksheets
If sh.Name = myValue Then flg = True: Exit For
Next
If flg = False Then
xlsheets.Add.Name = myValue
End If
Set xlSheet = xlWorkbook.Worksheets(myValue) ‘end worksheet input
****** 'blah, blah, workbook formatting code here*******
'Save And Cleanup
Set xlSheet = Nothing
SaveName = FilePath & Part.partname & ".xls"
If ResFileExists = False Then
xlWorkBook.SaveAs SaveName
Else
xlWorkBook.Save
End If
xlWorkbook.Close
Set xlWorkbook = Nothing
xlWorkbooks.Close
Set xlWorkbooks = Nothing
xlApp.Quit
Set xlApp = Nothing
LabelEnd:
End Sub
答案 0 :(得分:0)
您对Excel对象的声明
Dim xlApp As Object
Dim xlWorkbooks As Object
Dim xlWorkbook As Object
Dim xlSheet As Object
Dim sh As Worksheet
你的清理对象
Set xlSheet = Nothing
Set xlWorkbook = Nothing
Set xlWorkbooks = Nothing
Set xlApp = Nothing
你错过了
Set sh = Nothing
此外,由于您是晚期绑定,您可能希望将Dim sh As Worksheet
更改为Dim sh As Object
关于错误处理,我看到一个孤立的LabelEnd:
。我不确定你是否正在使用它。
这是使用错误处理的一种方法。
Sub Sample()
On Error GoTo Whoa
'
'~~> Rest of your code
'
Letscontinue:
'~~> Save And Cleanup
Set xlSheet = Nothing
Set sh = Nothing
SaveName = FilePath & Part.partname & ".xls"
If ResFileExists = False Then
xlWorkbook.SaveAs SaveName
Else
xlWorkbook.Save
End If
xlWorkbook.Close
Set xlWorkbook = Nothing
xlWorkbooks.Close
Set xlWorkbooks = Nothing
xlApp.Quit
Set xlApp = Nothing
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub