Excel рабочая книга закрытие, но рабочий лист остается активным?

Итак, у меня есть этот сценарий, который у меня запущен, но изменен для сортировки данных на разные листы на основе поля ввода. Он работает и делает все, что я хочу, но теперь, каждый раз, когда я его запускаю, новый экземпляр Excel работает в фоновом режиме. Насколько я могу судить (и я действительно мало знаю об этом), так это то, что книга закрывается, но рабочий лист остается активным. Я искал вещи и читал часами, пытаясь понять это, я, по крайней мере, направляюсь в правильном направлении? Это базовый сценарий, вставленный в программу DMIS для ПК (вне Excel). У меня есть изменения, которые я сделал для достижения сортировочного процесса (2 абзаца), отмеченный «рабочего лист ввода»: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 Cavity As String            ‘start worksheet input 1 
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  ‘end worksheet input 1 

'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 xlApp = CreateObject("Excel.Application") 

Set xlWorkbook = xlWorkbooks.Open(TempFilename) 
Set xlSheet = xlWorkbook.Worksheets("Sheet1") 
Set xlsheets = xlworkbook.worksheets     ‘start worksheet input 2 

'Set xlWorksheets = xlapp.Worksheet 
'Set xlWorksheets = xlapp.Worksheets 
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 2 


If ResFileExists = False Then 
    RCount=6 
    CCount=3 
    xlSheet.Range("B1").Value = Part.PartName 
    xlSheet.Range("A6").Value = Date() & " " & Time() 
    xlSheet.Range("B6").Value = "Inspector Name" 
    For Each Cmd In Cmds 
     'Eliminate DATDEF's 
     If Cmd.Type <> 1299 Then 
      'Do Dimensions 
      If Cmd.IsDimension Then 
       If Cmd.Type = DIMENSION_START_LOCATION Or Cmd.Type = DIMENSION_TRUE_START_POSITION Then 
        Set DcmdID = Cmd.DimensionCommand 
         DimID = DcmdID.ID 
         ReportDim = Cmd.GetText (OUTPUT_TYPE, 0) 
       End If 
       If Cmd.Type <> DIMENSION_START_LOCATION And Cmd.Type <> DIMENSION_END_LOCATION And _ 
        Cmd.Type <> DIMENSION_TRUE_START_POSITION And Cmd.Type <> DIMENSION_TRUE_END_POSITION Then 
        Set DCmd = Cmd.DimensionCommand 
        CheckDim = Cmd.GetText (OUTPUT_TYPE, 0) 
        If CheckDim <> "" Then 
          ReportDim = CheckDim 
        End If 
        If ReportDim = "BOTH" Or ReportDim = "REPORT" Then 
         If DCmd.ID = "" Then 
           xlSheet.Cells(5,CCount).Value = DimID & "."& DCmd.AxisLetter 
         Else 
           xlSheet.Cells(5,CCount).Value = DCmd.ID & "." & "M" 
         End If 
           xlSheet.Cells(2,CCount).Value = DCmd.Nominal 
           xlSheet.Cells(3,CCount).Value = DCmd.Plus 
           xlSheet.Cells(4,CCount).Value = DCmd.Minus 
           'Measured Or Deviation With check For True Position 
        If DCmd.AxisLetter <> "TP" Then 
            xlSheet.Cells(6,CCount).Value = DCmd.Measured 
       Else 
            xlSheet.Cells(6,CCount).Value = DCmd.Deviation 
       End If 
           'Add Min/Max For Profile dimensions 
           If Cmd.Type = 1118 Or Cmd.Type = 1105 Then 
            CCount=CCount+1 
            xlSheet.Cells(5,CCount).Value = DCmd.ID & "." & "Max" 
            xlSheet.Cells(2,CCount).Value = DCmd.Nominal 
            xlSheet.Cells(3,CCount).Value = DCmd.Plus 
            xlSheet.Cells(4,CCount).Value = DCmd.Minus 
            xlSheet.Cells(6,CCount).Value = DCmd.Max 
            CCount=CCount+1 
            xlSheet.Cells(5,CCount).Value = DCmd.ID & "." & "Min" 
            xlSheet.Cells(2,CCount).Value = DCmd.Nominal 
            xlSheet.Cells(3,CCount).Value = DCmd.Plus 
            xlSheet.Cells(4,CCount).Value = DCmd.Minus 
            xlSheet.Cells(6,CCount).Value = DCmd.Min 
           End If 
           CCount=CCount+1 
        End If 
       End If 
      End If 
      'Do GDT 
      If Cmd.Type = 184 Then 
        ReportDim = Cmd.GetText (OUTPUT_TYPE, 0) 
        If ReportDim = "BOTH" Or ReportDim = "REPORT" Then 
         xlSheet.Cells(5,CCount).Value = Cmd.GetText (ID, 0) & "." & "FCF" 
         xlSheet.Cells(2,CCount).Value = "0" 
         xlSheet.Cells(3,CCount).Value = Cmd.GetText (LINE2_PLUSTOL, 1) 
         xlSheet.Cells(4,CCount).Value = "0" 
         xlSheet.Cells(6,CCount).Value = Cmd.GetText (LINE2_DEV, 1) 
         CCount=CCount+1 
        End If 
      End If 
     End If 
    Next Cmd 


Else 

'Find first Open column. 
RCount=6 
Found=0 
Do Until Found = 1 
RCount = RCount + 1 
If xlSheet.Cells(RCount,1).Value = "" Then 
Found=1 
End If 
Loop 

xlSheet.Cells(RCount,1).Value = Date() & " " & Time() 
xlSheet.Cells(RCount,2).Value= "Inspector Name" 

'Fill In measured data 
CCount = 3 
    For Each Cmd In Cmds 
     'Eliminate DATDEF's 
     If Cmd.Type <> 1299 Then 
      'Do Dimensions 
      If Cmd.IsDimension Then 
       If Cmd.Type = DIMENSION_START_LOCATION Or Cmd.Type = DIMENSION_TRUE_START_POSITION Then 
        Set DcmdID = Cmd.DimensionCommand 
         DimID = DcmdID.ID 
         ReportDim = Cmd.GetText (OUTPUT_TYPE, 0) 
       End If 
       If Cmd.Type <> DIMENSION_START_LOCATION And Cmd.Type <> DIMENSION_END_LOCATION And _ 
        Cmd.Type <> DIMENSION_TRUE_START_POSITION And Cmd.Type <> DIMENSION_TRUE_END_POSITION Then 
        Set DCmd = Cmd.DimensionCommand 
        CheckDim = Cmd.GetText (OUTPUT_TYPE, 0) 
        If CheckDim <> "" Then 
          ReportDim = CheckDim 
        End If 
        If ReportDim = "BOTH" Or ReportDim = "REPORT" Then 
           'Measured Or Deviation With check For True Position 
          If DCmd.AxisLetter <> "TP" Then 
            xlSheet.Cells(RCount,CCount).Value = DCmd.Measured 
       Else 
            xlSheet.Cells(RCount,CCount).Value = DCmd.Deviation 
       End If 
           'Add Min/Max For Profile dimensions 
           If Cmd.Type = 1118 Or Cmd.Type = 1105 Then 
            CCount=CCount+1 
            xlSheet.Cells(RCount,CCount).Value = DCmd.Max 
            CCount=CCount+1 
            xlSheet.Cells(RCount,CCount).Value = DCmd.Min 
           End If 
         Ccount=Ccount+1 
        End If 
       End If 
      End If 
      'Do GDT 
      If Cmd.Type = 184 Then 
        ReportDim = Cmd.GetText (OUTPUT_TYPE, 0) 
        If ReportDim = "BOTH" Or ReportDim = "REPORT" Then 
         xlSheet.Cells(RCount,CCount).Value = Cmd.GetText (ID, 0) & "." & "FCF" 
         xlSheet.Cells(RCount,CCount).Value = "0" 
         xlSheet.Cells(RCount,CCount).Value = Cmd.GetText (LINE2_PLUSTOL, 1) 
         xlSheet.Cells(RCount,CCount).Value = "0" 
         xlSheet.Cells(RCount,CCount).Value = Cmd.GetText (LINE2_DEV, 1) 
         CCount=CCount+1 
        End If 
      End If 
     End If 
    Next Cmd 
End If 


'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

источник

2013-10-11 Jimmy Jennings

длинный короткий, но у вас есть строка 'Set xlApp = CreateObject (" Excel.Application ")' дважды. Может быть, удалить его и попробовать еще раз? – Jaycal

Да, это уже было указано и исправлено, но все еще не работает –

... Так

Set xlApp = CreateObject("Excel.Application")

создаст новый экземпляр Excel, вы можете сначала проверьте, установлен ли экземпляр Excel с помощью следующего кода.

On Error Resume Next 
Set xlApp = GetObject("","Excel.Application") 
If Err.Number <> 0 Then 
    'No instance exists, create one 
    Set xlApp = CreateObject("Excel.Application") 
End If 
Err.Clear

источник

2013-10-12 16:33:57 Jaycal

Эй, спасибо. Я был занят другими проектами, и сейчас я возвращаюсь к этому. Я попытался использовать код, который вы мне дали, но мне пришлось изменить вторую строку, чтобы установить xlApp = GetObject ("", "Excel.Application"), потому что я получал синтаксическую ошибку и добавил «Then» после <> 0. Это проходит без ошибок, но вовсе не открывает Excel. –

обновил код. Этот код будет (должен) открывать экземпляр excel, но он не будет виден. Вы хотите, чтобы это было видно? – Jaycal

Это именно то, что у меня есть сейчас, но по какой-то причине оно не делает «создать объект». Он не пишет в Excel вообще по какой-то причине –

Excel рабочая книга закрытие, но рабочий лист остается активным?

ответ

Смежные вопросы