TheSwamp
Code Red => VB(A) => Topic started 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.
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
-
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?
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
-
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
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
-
Hey Matt, when I made the change you made above, I error out with a 91 error code.
objExcel.Sheets("Sheet1").Activate
Set objExcelSheet = objExcel.ActiveWorkbook.Sheets("Sheet1")
maybe you need to see this part to see why the error occured
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
-
I think the second line was causing it to bomb when I didn't set it to the objExcelSheet
-
here is the complete module
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