having problems controlling excel through autocad.. here is my code

since i no longer play video games, if you can get my code working using close to the same syntax and notate it out so i can understand it then all my fg is yours!!

{Global Dwg_Name As String, Cur_TxtSTR As String, EOC As Integer
Global text_coll As New Collection
'declaration of public variables


Sub SS_delete(X As Byte)
If ThisDrawing.SelectionSets.Count > 0 Then
Dim i As Integer
On Error Resume Next
For i = 0 To ThisDrawing.SelectionSets.Count - 1
ThisDrawing.SelectionSets.Item(i).Delete
Next i
On Error GoTo 0
End If
End Sub


Sub GetText()
Dim gpCode(1) As Integer
Dim dataValue(1) As Variant
Dim SS_text As AcadSelectionSet
Dim i As Integer
Dwg_Name = ActiveDocument.Name
Dim Ncnt As Integer
Ncnt = Len(Dwg_Name)

Select Case Ncnt
Case 17
Dwg_Name = Mid(Dwg_Name, 1, 13)
Case 18
Dwg_Name = Mid(Dwg_Name, 1, 14)
Case 19
Dwg_Name = Mid(Dwg_Name, 1, 15)
Case 20
Dwg_Name = Mid(Dwg_Name, 1, 16)
End Select

SS_delete 1

Set SS_text = ThisDrawing.SelectionSets.Add("SS_text")
gpCode(0) = 0: dataValue(0) = "*text"
gpCode(1) = 8: dataValue(1) = "text"

SS_text.Select acSelectionSetAll, , , gpCode, dataValue

Dim cur_txtObj As AcadText
Dim Ccnt As Integer, C As Integer
Dim Ent As AcadEntity

For Each Ent In SS_text
If UCase(Ent.ObjectName) = UCase("ACDBTEXT") _
Or UCase(Ent.ObjectName) = UCase("ACDBMTEXT") Then
Set cur_txtObj = Ent
Cur_TxtSTR = cur_txtObj.TextString
Ccnt = Len(Cur_TxtSTR)
If Ccnt <= 6 And Mid(Cur_TxtSTR, 4, 1) = "-" Then
Cur_TxtSTR = "CCU3-" & Cur_TxtSTR
text_coll.Add Cur_TxtSTR
End If

End If

Next Ent
EOC = text_coll.Count
C = 1
For i = 1 To EOC
If C > EOC Then Exit For
Cur_TxtSTR = text_coll(i)
For n = 2 To EOC
If Cur_TxtSTR = text_coll(n) And n <> C Then
text_coll.Remove (n)
EOC = text_coll.Count
Exit For
End If
Next n
C = C + 1
Next i
RetrieveEXC
ExcelWork
End Sub


' Declare Working Directory
Global Const WrkDir = "C:\Documents and Settings\moorerb\Desktop\asset worksheets\"
' Declare Excel Workbook name
Global Const Master_WorkBook = WrkDir & "bptags.xls"
Global Const Secondary_WorkBook = WrkDir & "mytemp.xls"
' Declare Excel Worksheet name
Global Const Master_WorkSheet = "ccu3"
Global Const Secondary_WorkSheet = "template"
Global Const Tertiary_worksheet = "sheet1"


Global test As Object
Global workbooks As Object
Global ExcelVer As Integer
Global ExcelServer As Object
Global MasWorksheet As Object
Global secWorksheet As Object
Global ObjWorkbook As Object
Global FileSaveName As String
' end of global variables


Sub RetrieveEXC()
Set ExcelServer = CreateObject("Excel.Application.11")
Set workbooks = ExcelServer.workbooks
workbooks.Add ("C:\Documents and Settings\moorerb\Desktop\asset worksheets\mytemp.xls")
workbooks.Open (Master_WorkBook)
Set secWorksheet = ExcelServer.ActiveWorkbook.worksheets(Secondary_WorkSheet)
Set MasWorksheet = ExcelServer.ActiveWorkbook.worksheets(Master_WorkSheet)

'ExcelServer.WindowState = -4140
ExcelServer.Visible = True
FileSaveName = WrkDir & Dwg_Name & ".xls"
End Sub

Sub ExcelWork()
Dim info As Boolean
Dim RowLocation As Long
Dim CSearch As Object
'Dim C_range As Range
'C_range = (A1)
info = False
Dim Ent As AcadEntity
Dim i As Integer

MasWorksheet.Activate

'MasWorksheet.Activate
MasWorksheet.Range(Selection, Selection.End(xlDown)).Select
For i = 1 To EOC
Cur_TxtSTR = text_coll(i)
If Cur_TxtSTR = xlValue Then
MasWorksheet.RowLocation = ActiveCell.row
MasWorksheet.Rows(RowLocation).Select
Selection.Copy
Selection.ClearContents
secWorksheet.Activate
ActiveSheet.Paste
secWorksheet.Range.Next.row
Else
MasWorksheet.Range.Next.row
End If
above is where my issue starts..


Next i

End Sub








Sub set_to_nil()
Set ExcelServer = Nothing
Set ObjWorksheet = Nothing
'set SecWorksheet = nothing
Set ObjWorkbook = Nothing

End Sub

Public Sub save_file()
ActiveWorkbook.SaveAs FileName:= _
FileSaveName, fileformat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
End Sub}

ill try to explain my self a little better

at this point I'm just trying to work in excel from autocad..

What i'm trying to do is get a collection of text that matches a specific criteria, open an excel spreadsheet, look for each in the first colomn of the spreadsheet, if the value from the dwg match the value in the cell, copy the entire row to a different spread sheet. once they are all found or as many as possible save it. i will notate red in the code.

i dont use vba, so you need to describe your problem better. is there an exception? does something crash? can you not open the file? what happens? can you explain what portion of the code is and is not working?

i put the issue in bold/italics and notated the problem with underline. i figured out the problem... it was increadaby small, I didn't define "A" variable and i needed a count.


Sub ExcelWork()
Dim i As Integer, n As Long
Dim CurrentItem As String
Dim pause As Boolean
Dim match As Object
MasWorksheet.Activate

MasWorksheet.cells(1, 1).Activate
'MasWorksheet.Activate.EntireColumn.autofit

For i = 1 To EOC
Cur_TxtSTR = text_coll(i)
For n = 1 To 876
CurrentItem = MasWorksheet.cells(n, 1).Value
If Cur_TxtSTR = CurrentItem Then
pause = True
MasWorksheet.Rows(n).Select
Set match = MasWorksheet.Rows(n)
'MasWorksheet.Rows(n).ClearContents
secWorksheet.Activate
secWorksheet.insert (match)
'secWorksheet.Range.Next.row
End If

Next n

Next i

End Sub

This post was edited by Zero_Pulze on May 30 2012 04:56am