TM1 Forum

Code: Select all

Sub xlObj0(xlCG As Boolean)
   If xlCG Then                                            '} if using existing xl
       xlApp.Visible = True                                '}
       xlApp.EnableEvents = True                           '}
       xlApp.DisplayAlerts = True                          '}
       Else                                                '}
       xlApp.Quit                                          '} quit if new xl created
   End If                                                  '}
   Set xlWkSh = Nothing
   Set xlWkBk = Nothing
   'Set xlApp = Nothing    'this also removes xl !?!
End Sub

Function xlObj1(pxlObj As String, pAlert As Boolean, pVis As Boolean, _
               pEvent As Boolean, Optional pWin As Integer = xlMinimized)
   Dim xlFound As Boolean, gErr As Boolean
   On Local Error GoTo xlERR                               'only sets xlobj
   Select Case pxlObj                                      '} get or create
    Case "c"                                               '}
     xlFound = False
     Set xlApp = CreateObject("excel.application")         '}
    Case "g"                                               '}
     xlFound = True
     Set xlApp = GetObject(, "excel.application")          '}
    Case Else                                              '}
   End Select                                              '}
   xlApp.DisplayAlerts = pAlert                            ' turn off app Dialogs
   xlApp.Visible = pVis                                    '}
   xlApp.EnableEvents = pEvent                             '}
   xlApp.WindowState = pWin
   xlObj1 = xlFound                                        'using existing or new xl
   Exit Function
xlERR:
   Debug.Print Err.Number; Err.Description
   If Err.Number = 429 Then                                '} 429 = ActiveX component can't
     Set xlApp = CreateObject("excel.application")         '} create object
     xlFound = False
   Else
     MsgBox Err.Number & " : " & Err.Description           '} diplay an unknown Error
     gErr = True                                           '} flag error to calling sub
     Exit Function
   End If
   Resume Next
End Function