+ Reply to Thread
Results 1 to 5 of 5

Workbook closing but worksheet staying active??

Hybrid View

  1. #1
    Registered User
    Join Date
    10-04-2013
    Location
    Michigan
    MS-Off Ver
    Excel 2002
    Posts
    9

    Workbook closing but worksheet staying active??

    So, I have this script that I had running, but modified to sort data into different sheets based on an input box. It works, and does everything I want it to, but now, every time I run it, a new instance of Excel runs in the background. As far as I can tell(and I don't really know much about this sort of thing), is that somehow the workbook is closing, but the worksheet is staying active. I've been looking up stuff and reading for hours trying to figure this out, am I at least heading in the right direction?? This is a basic script inserted into a PC DMIS program(outside of Excel). I have the changes I made to achieve the sorting process(2 paragraphs) marked with "worksheet input:

    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

  2. #2
    Forum Expert millz's Avatar
    Join Date
    08-14-2013
    Location
    Singapore
    MS-Off Ver
    Excel, Access 2016
    Posts
    1,694

    Re: Workbook closing but worksheet staying active??

    you have 2 lines of
    Set xlApp = CreateObject("Excel.Application")
    so the first one gets lost in the sea when the second line comes

  3. #3
    Registered User
    Join Date
    10-04-2013
    Location
    Michigan
    MS-Off Ver
    Excel 2002
    Posts
    9

    Re: Workbook closing but worksheet staying active??

    Oops, that must be left over from some failed attempt at something that I missed when deleting

  4. #4
    Registered User
    Join Date
    10-04-2013
    Location
    Michigan
    MS-Off Ver
    Excel 2002
    Posts
    9

    Re: Workbook closing but worksheet staying active??

    Tried removing that line, but am still having trouble, uggggh

  5. #5
    Forum Expert millz's Avatar
    Join Date
    08-14-2013
    Location
    Singapore
    MS-Off Ver
    Excel, Access 2016
    Posts
    1,694

    Re: Workbook closing but worksheet staying active??

    add a
    Set xlSheets = Nothing
    after
    Set xlSheet = Nothing
    see if it helps?

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Closing non-active workbook
    By patelh9 in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 07-18-2010, 12:09 AM
  2. Problem With Opening and Closing A Workbook In VBA Using a Range Name In The Active W
    By John Vieren in forum Excel Programming / VBA / Macros
    Replies: 6
    Last Post: 12-28-2009, 09:22 AM
  3. closing the active workbook
    By jmoffat in forum Excel Programming / VBA / Macros
    Replies: 6
    Last Post: 05-03-2006, 08:21 AM
  4. Closing Hidden Workbook when Active Workbook is Closed
    By SusanK521 in forum Excel Programming / VBA / Macros
    Replies: 5
    Last Post: 09-23-2005, 08:05 PM
  5. [SOLVED] Closing a workbook and printing a non-active page
    By Sleeping Bear in forum Excel Programming / VBA / Macros
    Replies: 4
    Last Post: 08-05-2005, 09:05 AM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1