TheSwamp

Code Red => VB(A) => Topic started by: David Hall on March 17, 2008, 03:19:05 PM

Title: activate wookbook wether open or closed
Post by: David Hall on March 17, 2008, 03:19:05 PM
well this should be fairly simple, I just dont know what Im doing so I cant find the setting I need.  What Im doing is opening an Excel spreadsheet if its closed, or I want to activate it if excell has it open.  The false part of the If is working, it opens the file and sets my sheet active. 

Code: [Select]
      blnRunning = IsAppRunning
      If blnRunning Then
            Set objExcel = GetObject(, "Excel.Application")
           
                  objExcel.Workbooks.Open strLogName
                  Set objExcelSheet = objExcel.ActiveWorkbook.Sheets("Sheet1")
           
      Else
            Set objExcel = CreateObject("Excel.Application")
            objExcel.UserControl = True
            objExcel.Visible = True
            objExcel.Workbooks.Open strLogName
            Set objExcelSheet = objExcel.ActiveWorkbook.Sheets("Sheet1")
      End If


Private Function IsAppRunning() As Boolean
      Dim objExcel As Excel.Application
      On Error Resume Next
      Set objExcel = GetObject(, "Excel.Application")
      IsAppRunning = (Err.Number = 0)
      Set objExcel = Nothing
      Err.Clear
End Function

Title: Re: activate wookbook wether open or closed
Post by: Guest on March 17, 2008, 03:50:49 PM
well this should be fairly simple, I just dont know what Im doing so I cant find the setting I need.  What Im doing is opening an Excel spreadsheet if its closed, or I want to activate it if excell has it open.  The false part of the If is working, it opens the file and sets my sheet active. 


You mean the TRUE part?

Quote
    blnRunning = IsAppRunning
    If blnRunning Then
        Set objExcel = GetObject(, "Excel.Application")
        objExcel.Workbooks.Open strLogName
        Set objExcelSheet = objExcel.ActiveWorkbook.Sheets("Sheet1")
    Else
        Set objExcel = CreateObject("Excel.Application")
        objExcel.UserControl = True
        objExcel.Visible = True
        objExcel.Workbooks.Open strLogName
'        Set objExcelSheet = objExcel.ActiveWorkbook.Sheets("Sheet1")
       
        objExcel.Sheets("Sheet1").Activate
Title: Re: activate wookbook wether open or closed
Post by: David Hall on March 17, 2008, 03:56:53 PM
Well I guess it depends on how you look at it.  If blnRunning is false (which it would be if Excel was not open), the
Code: [Select]
If blnRunning then evaluates to false, so it goes to the Else, which I was calling the false part.  Autocad then creates an instance of excel, and opens the workbook
Title: Re: activate wookbook wether open or closed
Post by: David Hall on March 17, 2008, 04:03:34 PM
Hey Matt, when I made the change you made above, I error out with a 91 error code.
Code: [Select]
            objExcel.Sheets("Sheet1").Activate
            Set objExcelSheet = objExcel.ActiveWorkbook.Sheets("Sheet1")

maybe you need to see this part to see why the error occured
Code: [Select]
strDwgNo = Left(ThisDrawing.Name, Len(ThisDrawing.Name) - 4)
      Set foundCell = objExcelSheet.Range("b4", objExcelSheet.Range("b4").End(xlDown)).Find(strDwgNo)
      If foundCell Is Nothing Then
            MsgBox ("Did not find a drawing #")
            objExcel.ActiveWorkbook.Save
            objExcel.Quit
            Exit Sub
      Else
            foundCell.Activate
            intActR = objExcel.ActiveCell.Row
            Set foundCell = Nothing
      End If
Title: Re: activate wookbook wether open or closed
Post by: David Hall on March 17, 2008, 04:04:20 PM
I think the second line was causing it to bomb when I didn't set it to the objExcelSheet
Title: Re: activate wookbook wether open or closed
Post by: David Hall on March 17, 2008, 04:06:01 PM
here is the complete module
Code: [Select]
Option Explicit
Public Sub PushAttributes()
      Dim objSelSet As AcadSelectionSet
      Dim objExcel As Excel.Application
      Dim objExcelSheet As Excel.Worksheet
      Dim intActR As Integer
      Dim blnFoundAttributes As Boolean
      Dim blnRunning As Boolean
      Dim strDwgNo As String
      Dim strProjectName As String
      Dim strLogName As String
      Dim foundCell As Range
      Dim intType(0 To 1) As Integer
      Dim varData(0 To 1) As Variant
      Dim objBlkRef As AcadBlockReference
      Dim atts As Variant
      Dim objSelCol As AcadSelectionSets
      Dim XL(6) As String
      Dim objAttRef As AcadAttributeReference

      On Error GoTo Err_Control:
      ThisDrawing.SetVariable "PROJECTNAME", "PushAtts"
      Set objSelCol = ThisDrawing.SelectionSets
      If objSelCol.Count > 0 Then
            For Each objSelSet In objSelCol
                  If objSelSet.Name = "Title" Then
                        objSelSet.Delete
                        Exit For
                  End If
            Next
      End If
      strProjectName = ThisDrawing.GetVariable("Projectname")
      'strLogName = "\\autocad\repro\projectlogs\" & strProjectName & ".xls"
      strLogName = "c:\PMS\" & strProjectName & ".xls"
      blnRunning = IsAppRunning
      If blnRunning Then
            Set objExcel = GetObject(, "Excel.Application")
            If objExcel.ActiveWorkbook = strProjectName Then
                  objExcel.Workbooks.Open strLogName
                  Set objExcelSheet = objExcel.ActiveWorkbook.Sheets("Sheet1")
            End If
      Else
            Set objExcel = CreateObject("Excel.Application")
            objExcel.UserControl = True
            objExcel.Visible = True
            objExcel.Workbooks.Open strLogName
            objExcel.Sheets("Sheet1").Activate
            Set objExcelSheet = objExcel.ActiveWorkbook.Sheets("Sheet1")
      End If




      '      objExcel.Workbooks.Open strLogName
      '      Set objExcelSheet = objExcel.ActiveWorkbook.Sheets("Sheet1")

      strDwgNo = Left(ThisDrawing.Name, Len(ThisDrawing.Name) - 4)
      Set foundCell = objExcelSheet.Range("b4", objExcelSheet.Range("b4").End(xlDown)).Find(strDwgNo)
      If foundCell Is Nothing Then
            MsgBox ("Did not find a drawing #")
            objExcel.ActiveWorkbook.Save
            objExcel.Quit
            Exit Sub
      Else
            foundCell.Activate
            intActR = objExcel.ActiveCell.Row
            Set foundCell = Nothing
      End If


      XL(0) = StrConv(objExcelSheet.Cells(intActR, 1).Value, 1)     'Sheet Number
      XL(1) = StrConv(objExcelSheet.Cells(intActR, 2).Value, 1)     'Drawing Number
      XL(2) = StrConv(objExcelSheet.Cells(intActR, 3).Value, 1)     'Revision Number
      XL(3) = StrConv(objExcelSheet.Cells(intActR, 4).Value, 1)     'Code Number
      XL(4) = StrConv(objExcelSheet.Cells(intActR, 5).Value, 1)     'Line 1
      XL(5) = StrConv(objExcelSheet.Cells(intActR, 6).Value, 1)     'Line 2
      XL(6) = StrConv(objExcelSheet.Cells(intActR, 7).Value, 1)     'Line 3

      Set objSelSet = objSelCol.Add("Title")
      intType(0) = 0: varData(0) = "INSERT"
      intType(1) = 2: varData(1) = "TITLINFO,VTITLINFO,8.5x11_BDR,vinfo"
      objSelSet.Select Mode:=acSelectionSetAll, filtertype:=intType, filterdata:=varData

      For Each objBlkRef In objSelSet
            If objBlkRef.HasAttributes Then
                  blnFoundAttributes = True
                  atts = objBlkRef.GetAttributes

                  Set objAttRef = atts(0)
                  objAttRef.TextString = XL(4)
                  Set objAttRef = atts(1)
                  objAttRef.TextString = XL(5)
                  Set objAttRef = atts(2)
                  objAttRef.TextString = XL(6)
                  Set objAttRef = atts(3)
                  objAttRef.TextString = XL(1)
                  Set objAttRef = atts(4)
                  objAttRef.TextString = XL(2)
                  Set objAttRef = atts(5)
                  objAttRef.TextString = XL(3)
                  Set objAttRef = atts(6)
                  objAttRef.TextString = XL(0)
            End If
      Next objBlkRef
      If Not blnRunning Then
      'We started the instance, so we can close it
            objExcel.ActiveWorkbook.Save
            objExcel.Quit
      End If
      ThisDrawing.Save
Exit_Here:
      strDwgNo = ""
      ThisDrawing.SetVariable "PROJECTNAME", "."
      Set objExcel = Nothing
      Set objExcelSheet = Nothing
      Exit Sub
Err_Control:
      objExcel.Quit
      Set objExcel = Nothing
      Set objExcelSheet = Nothing
      MsgBox Err.Description, vbOKOnly, Err.Number
      Resume Exit_Here
End Sub

'This determines how to set the Excel instance.
Private Function IsAppRunning() As Boolean
      Dim objExcel As Excel.Application
      On Error Resume Next
      Set objExcel = GetObject(, "Excel.Application")
      IsAppRunning = (Err.Number = 0)
      Set objExcel = Nothing
      Err.Clear
End Function