Author Topic: Find empty cell from Autocad VBA  (Read 7721 times)

0 Members and 1 Guest are viewing this topic.

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4075
Re: Find empty cell from Autocad VBA
« Reply #15 on: November 15, 2006, 11:32:30 AM »
Sooooooooo close and yet it eludes me.  I did as Dnereb suggested, and copied the macro from excel
Code: [Select]
    Range("B2:B6").Select
    Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortTextAsNumbers

which had to be worked over to use my range

Code: [Select]
objExcelSheet.Range("b2", "b" & NextLine).Select
   
    objExcel.Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers
   

But it bombs on the sort.  Any ideas?
« Last Edit: November 15, 2006, 11:54:19 AM by CmdrDuh »
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

Dnereb

  • Guest
Re: Find empty cell from Autocad VBA
« Reply #16 on: November 15, 2006, 12:29:16 PM »
early bound:

'To late bind alter all Excell.xxxxxx declarations into Object
Dim Wb As Excel.Workbook
Dim objExcelSheet As Excel.Worksheet
Dim Rng As Excel.Range

'assumming you've set the Excell.application somewher already

Set Wb = ExcellApp.ActiveWorkbook
Set objExcelSheet = Wb.Worksheets(1)
Set Rng = objExcelSheet.Range("b2:b6")
   
Rng.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers
   
Set Rng = Nothing
Set objExcelSheet = Nothing
Set Wb = Nothing

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4075
Re: Find empty cell from Autocad VBA
« Reply #17 on: November 15, 2006, 02:34:05 PM »
ok, now im more confused than before

Here is what Im using
Code: [Select]
Option Explicit
Dim objSelSet As AcadSelectionSet
Dim objSelected As Object

Dim objExcel As Excel.Application
Dim objExcelSheet As Excel.Worksheet
Dim objExcelWb As Excel.Workbook
Dim objExcelRange As Range

'Dim objElem As Object

Dim varArray1 As Variant       ' Array to store entity attributes
Dim intCount, intActR As Integer  ' Counts the number of elements in the array
Dim blnFoundAttributes As Boolean    'Monitors whether entity has attributes
Dim blnRunning As Boolean      ' Determines if Excel is running

Dim foundCell As Range         ' Cell containing drawing #
Dim objBlkRef As AcadBlockReference
Dim objAttRef As AcadAttributeReference
Dim i As Integer, TotalBlocks As Integer, iCount As Integer, intType(0 To 1) As Integer
Dim varAtts As Variant, Atts As Variant, varData(0 To 1) As Variant
Dim objSelCol As AcadSelectionSets

Public strpms As String
Dim intQuantity As Integer
Dim strBlockName As String
Dim strStoresNumber As String
Const BottomRowNum = 65536

Private Sub PMS_Get_Number()
    frmPMS.Show
End Sub

Public Function GetLastRow() As Long
    Dim wks As Excel.Worksheet
    Set wks = objExcel.ActiveSheet
    Dim i As Long
    For i = 1 To BottomRowNum
        If IsEmpty(wks.Cells(i, 2)) Then
            GetLastRow = i - 1
            Exit Function
        End If
    Next
    GetLastRow = BottomRowNum
End Function

Public Sub PMSLog()
    On Error GoTo Err_Control:
    PMS_Get_Number
    strpms = "c:\PMS\" & strpms & ".xls"
    Set objSelCol = ThisDrawing.SelectionSets
    For Each objSelSet In objSelCol
        If objSelSet.Name = "PMS" Then
            objSelSet.Delete
            Exit For
        End If
    Next

    Set objSelSet = objSelCol.Add("PMS")
    intType(0) = 0: varData(0) = "INSERT"
    intType(1) = 2: varData(1) = "*"
    objSelSet.Select Mode:=acSelectionSetAll, filtertype:=intType, filterdata:=varData

    blnRunning = IsAppRunning
    If blnRunning Then
        Set objExcel = GetObject(, "Excel.Application")
        objExcel.UserControl = True
        objExcel.Visible = True
    Else
        Set objExcel = CreateObject("Excel.Application")
        objExcel.UserControl = True
        objExcel.Visible = True
        objExcel.Workbooks.Open strpms
    End If

    Set objExcelSheet = objExcel.ActiveWorkbook.Sheets("Sheet1")
    objExcelSheet.Range("b2", objExcelSheet.Range("b2").End(xlDown)) = Null
    objExcelSheet.Range("a2", objExcelSheet.Range("a2").End(xlDown)) = Null
    objExcelSheet.Range("a2", objExcelSheet.Range("a2").End(xlDown)).NumberFormat = 0#
    objExcelSheet.Range("b2", objExcelSheet.Range("b2").End(xlDown)).NumberFormat = "@"

    'objExcelSheet.Range("a2", objExcelSheet.Range("a2").End(xlDown)) = 0
    For Each objBlkRef In objSelSet
        If objBlkRef.HasAttributes Then
            varArray1 = objBlkRef.GetAttributes
            For intCount = LBound(varArray1) To UBound(varArray1)
                Select Case varArray1(intCount).TagString
                Case "STORESNUMBER"
                    strStoresNumber = varArray1(intCount).TextString
                    Set foundCell = objExcelSheet.Range("b2", objExcelSheet.Range("b2").End(xlDown)).Find(strStoresNumber)

                    If foundCell Is Nothing Then
                        'add stores number to the list
                        Dim NextLine As Long
                        NextLine = GetLastRow() + 1
                        objExcelSheet.Cells(NextLine, 2).Value = strStoresNumber
                    Else

                        Set foundCell = Nothing
                    End If
                End Select
            Next intCount


        End If
    Next
'**********************************************************************
   

Set objExcelWb = objExcel.ActiveWorkbook
Set objExcelSheet = objExcelWb.Worksheets(1)
objExcelRange = objExcelSheet.Range("b2", "b" & NextLine).Select
objExcelRange.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers
'************************************************************************

    While NextLine > 1
        objExcelSheet.Cells(NextLine, 1).Value = 0
        NextLine = NextLine - 1
    Wend
    For Each objBlkRef In objSelSet
        If objBlkRef.HasAttributes Then
            varArray1 = objBlkRef.GetAttributes
            For intCount = LBound(varArray1) To UBound(varArray1)
                Select Case varArray1(intCount).TagString
                Case "STORESNUMBER"
                    strStoresNumber = varArray1(intCount).TextString

                    Set foundCell = objExcelSheet.Range("b2", objExcelSheet.Range("b2").End(xlDown)).Find(strStoresNumber)
                    'Set foundCell = Columns("A").Find(strDwgNo)
                    If foundCell Is Nothing Then
                        MsgBox ("Did not find a stores number #")
                        Exit Sub
                    Else
                        foundCell.Activate
                        intActR = objExcel.ActiveCell.Row
                        Dim val As String

                        Set foundCell = Nothing
                    End If
                End Select
            Next intCount

            objExcelSheet.Cells(intActR, 1).Value = CStr(objExcelSheet.Cells(intActR, 1).Value) + 1
        End If
    Next objBlkRef
    If Not blnRunning Then
        'We started the instance, so we can close it
        objExcel.ActiveWorkbook.Save
        objExcel.Quit
    Else
        objExcel.ActiveWorkbook.Save
    End If


Exit_Here:
    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

Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

Dnereb

  • Guest
Re: Find empty cell from Autocad VBA
« Reply #18 on: November 15, 2006, 03:50:33 PM »
CmdrDuh,

I've reworked your code "a bit" and added some comments. Two major issues caught my eye.
1) The recorder uses .Select to imitate exactly what is going on, but in code you do not need to select
you can manipulate any object directly if you've placed it in a variable
2) Avoid .active..... because during the run of your code the user can select another in one click of the mouse button (cell,worksheet or workbook alike)

Code: [Select]
Option Explicit
Dim objSelSet As AcadSelectionSet
Dim objSelected As Object

Dim objExcel As Excel.Application
Dim objExcelSheet As Excel.Worksheet
Dim objExcelWb As Excel.Workbook
Dim objExcelRange As Excel.Range

'Dim objElem As Object

Dim varArray1 As Variant       ' Array to store entity attributes
Dim intCount, intActR As Integer  ' Counts the number of elements in the array
Dim blnFoundAttributes As Boolean    'Monitors whether entity has attributes
'the boolean noe indicates if Excel was or was not running prior to this macro
Dim blnRunning As Boolean      ' Determines if Excel is running
Dim BlnWorkbookPresent As Boolean 'Flags if the workbook was already open

Dim foundCell As Excel.Range         ' Cell containing drawing #
Dim objBlkRef As AcadBlockReference
Dim objAttRef As AcadAttributeReference
Dim i As Integer, TotalBlocks As Integer, iCount As Integer, intType(0 To 1) As Integer
Dim varAtts As Variant, Atts As Variant, varData(0 To 1) As Variant
Dim objSelCol As AcadSelectionSets


Dim intQuantity As Integer
Dim strBlockName As String
Dim strStoresNumber As String

Const BottomRowNum = 65536   'eeuw! that is ugly the next Excel will have way more rows!
'you should adjust this
Const FILENAME_PMS = "C:\PMS\Test.xls"
'just for easy use
Const WORKBOOKNAME_PMS = "Test"

Private Sub PMS_Get_Number()
    frmPMS.Show
End Sub

'Reworked that one to avoid the loop
Public Function GetLastRow() As Long
    Dim Wks As Excel.Worksheet
   
    Set Wks = objExcel.ActiveSheet 'this is a bit dangerous if Excel is visible because the user can activate another sheet
   
    'usedrange defines the area that's been altered on a sheet
    'of course the used range can start several rows below the first row.
    GetLastRow = Wks.UsedRange.Row + Wks.UsedRange.Rows.Count
    Set Wks = Nothing
   
End Function

Public Sub PMSLog()
    On Error GoTo Err_Control:
    PMS_Get_Number
    Set objSelCol = ThisDrawing.SelectionSets
    For Each objSelSet In objSelCol
        If objSelSet.Name = "PMS" Then
            objSelSet.Delete
            Exit For
        End If
    Next

    Set objSelSet = objSelCol.Add("PMS")
    intType(0) = 0: varData(0) = "INSERT"
    intType(1) = 2: varData(1) = "*"
    objSelSet.Select Mode:=acSelectionSetAll, filtertype:=intType, filterdata:=varData
    '---------------------------------------------------------
    'this is double up because you use getobject to determine
    'if excel is running
    'use the error to create an instance if it is not running
    'blnRunning = IsAppRunning
    '---------------------------------------------------------
    'If blnRunning Then
    '    Set objExcel = GetObject(, "Excel.Application")
    '    objExcel.UserControl = True
    '    objExcel.Visible = True
    'Else
    '    Set objExcel = CreateObject("Excel.Application")
    '    objExcel.UserControl = True
    '    objExcel.Visible = True
    '    objExcel.Workbooks.Open strpms
    'End If
    On Error GoTo NoExcel
    blnRunning = True 'will be set to false if it wasn't in the error handler
    Set objExcel = GetObject(, "Excel.Application")
    objExcel.UserControl = True
    objExcel.Visible = True
    'search for the desired workbook if Excel was already open (you never know!)
    If blnRunning Then
        For Each objExcelWb In objExcel.Workbooks
            If objExcelWb.Name = WORKBOOKNAME_PMS Then
                BlnWorkbookPresent = True
                Exit For
            End If
        Next
    End If
    If Not BlnWorkbookPresent Then Set objExcelWb = objExcel.Workbooks.Open(FILENAME_PMS)
    'now you have controle over the workbook because you have an instance
    '(objExcelWb) so you can adres it directly
       
    'No use of active needed anymore
    Set objExcelSheet = objExcelWb.Sheets("Sheet1")
    'to late bind you need to use -4121 instead of xldown (the number it represents)
    objExcelSheet.Range("b2", objExcelSheet.Range("b2").End(xlDown)) = Null
    objExcelSheet.Range("a2", objExcelSheet.Range("a2").End(xlDown)) = Null
    objExcelSheet.Range("a2", objExcelSheet.Range("a2").End(xlDown)).NumberFormat = 0#
    objExcelSheet.Range("b2", objExcelSheet.Range("b2").End(xlDown)).NumberFormat = "@"

    'objExcelSheet.Range("a2", objExcelSheet.Range("a2").End(xlDown)) = 0
    For Each objBlkRef In objSelSet
        If objBlkRef.HasAttributes Then
            varArray1 = objBlkRef.GetAttributes
            For intCount = LBound(varArray1) To UBound(varArray1)
                Select Case varArray1(intCount).TagString
                Case "STORESNUMBER"
                    strStoresNumber = varArray1(intCount).TextString
                    Set foundCell = objExcelSheet.Range("b2", objExcelSheet.Range("b2").End(xlDown)).Find(strStoresNumber)

                    If foundCell Is Nothing Then
                        'add stores number to the list
                        Dim NextLine As Long
                        NextLine = GetLastRow() + 1
                        objExcelSheet.Cells(NextLine, 2).Value = strStoresNumber
                    Else

                        Set foundCell = Nothing
                    End If
                End Select
            Next intCount


        End If
    Next
'**********************************************************************
   
'Already set the workbook
'Set objExcelWb = objExcel.ActiveWorkbook
Set objExcelSheet = objExcelWb.Worksheets(1)
'Select is used by the recorde to mimic exactly what you are doing, but in code you do not need to select stuff to alter it.
'Btw: Ranges are defined ("A1:C5") in my Excel not(A1,C5)
Set objExcelRange = objExcelSheet.Range("B2:B" & NextLine) '.Select
objExcelRange.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers
'************************************************************************

    While NextLine > 1
        objExcelSheet.Cells(NextLine, 1).Value = 0
        NextLine = NextLine - 1
    Wend
    For Each objBlkRef In objSelSet
        If objBlkRef.HasAttributes Then
            varArray1 = objBlkRef.GetAttributes
            For intCount = LBound(varArray1) To UBound(varArray1)
                Select Case varArray1(intCount).TagString
                Case "STORESNUMBER"
                    strStoresNumber = varArray1(intCount).TextString

                    Set foundCell = objExcelSheet.Range("b2", objExcelSheet.Range("b2").End(xlDown)).Find(strStoresNumber)
                    'Set foundCell = Columns("A").Find(strDwgNo)
                    If foundCell Is Nothing Then
                        MsgBox ("Did not find a stores number #")
                        Exit Sub
                    Else
                        'no need to activate
                        'foundCell.Activate
                        'Use the object direcly like:
                        intActR = foundCell.Row
                        Dim val As String
                        Set foundCell = Nothing
                    End If
                End Select
            Next intCount

            objExcelSheet.Cells(intActR, 1).Value = CStr(objExcelSheet.Cells(intActR, 1).Value) + 1
        End If
    Next objBlkRef
    If Not blnRunning Then
        'We started the instance, so we can close it
        'Again use the object directly and avoid active, users have an annoying habbit of clicking
        'while bored.
        objExcelWb.Save
        objExcel.Quit
    Else
        objExcelWb.Save
    End If


Exit_Here:
    ' do it the other way around always set the dependent object to nothing first
    '(in order of dependancy: Range,Worksheet,Workbook,Application)
    'Set objExcel = Nothing
    'Set objExcelSheet = Nothing
    Set foundCell = Nothing
    Set objExcelRange = Nothing
    Set objExcelSheet = Nothing
    Set objExcelWb = Nothing
    Set objExcel = Nothing
    Exit Sub
Err_Control:
    objExcel.Quit
    Set objExcel = Nothing
    Set objExcelSheet = Nothing
    MsgBox Err.Description, vbOKOnly, Err.Number
    Resume Exit_Here
Exit Sub
NoExcel:
Set objExcel = CVreateObject("Excel.Application")
blnRunning = False 'the boolean noe indicates if Excel was or was not running prior to this macro
'continue on the next line for an instance of Excel is now present :)
Resume Next
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

I can not test it (no acad at home for one, and living at GMT +1) so it bounds to have some bugs.
To late bind it replace all Excel.xxxxx to Object end replace Excel constants like XlDown with their corresponding number.
This way the code will run Excel version independent. Note: keep it early bound while developing, it will save you time.

Fatty

  • Guest
Re: Find empty cell from Autocad VBA
« Reply #19 on: November 15, 2006, 03:58:11 PM »
Hi, Commandor
It's me again
At a first glance I don't see where you close a workbook
I use something like this:

Code: [Select]
    objBook.Close SaveChanges:=True
    objExcel.Quit

and then clean up all in reverse hyerarchcal order as
Dnereb said

Hth

~'J'~

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4075
Re: Find empty cell from Autocad VBA
« Reply #20 on: November 15, 2006, 04:38:59 PM »
are you meaning this?
Code: [Select]
    If Not blnRunning Then
        'We started the instance, so we can close it
        objExcel.ActiveWorkbook.Save
        objExcel.Quit
    Else
        objExcel.ActiveWorkbook.Save
    End If
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4075
Re: Find empty cell from Autocad VBA
« Reply #21 on: November 15, 2006, 05:05:13 PM »
ok, I had to ask a guy here at work, and he came up with this
Code: [Select]
Private Sub sortexcel()
''To late bind alter all Excell.xxxxxx declarations into Object
Dim Wb As Excel.Workbook
Dim objExcelSheet As Excel.Worksheet
Dim Rng As Excel.Range
Dim Rng2 As Excel.Range

'assumming you've set the Excell.application somewher already
'Set Wb = ExcellApp.ActiveWorkbook
Set Wb = objExcel.ActiveWorkbook
Set objExcelSheet = Wb.Worksheets(1)
Set Rng = objExcelSheet.Range("B2:" & "B" & NextLine)
Set Rng2 = objExcelSheet.Range("B2")

Rng.Sort Rng2
Set Rng = Nothing
Set objExcelSheet = Nothing
Set Wb = Nothing
End Sub

He had to create rng2, I dont know why, but it works.

Next step is programming the formulas in to the cells for lookup tables
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4075
Re: Find empty cell from Autocad VBA
« Reply #22 on: November 15, 2006, 05:07:08 PM »
Is there anyway to have a macro in either excel or autocad that can look to see how many rows are used and insert based on that number?
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4075
Re: Find empty cell from Autocad VBA
« Reply #23 on: November 15, 2006, 05:15:13 PM »
Quote
To late bind it replace all Excel.xxxxx to Object end replace Excel constants like XlDown with their corresponding number.
This way the code will run Excel version independent. Note: keep it early bound while developing, it will save you time.
I hate to sound like a complete noob, but what exactly does that mean.  I never understood early vs late binding
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

Bryco

  • Water Moccasin
  • Posts: 1882
Re: Find empty cell from Autocad VBA
« Reply #24 on: November 15, 2006, 06:45:10 PM »
I can give you a bodgey version of early/late

Dim Excel As Object         
'Excel As Excel.Application
 Dim ExcelSheet As Object   
'ExcelWorkbook As Workbook
 Dim ExcelWorkbook As Object
'ExcelSheet As Worksheet
 Dim r As Object             
'R As Range

I'll often dim a sub like I've shown, dimming ExcelSheet As Worksheet gives me access to intellisense so it's easier to write the sub. When I'm finished I'll comment that out and dim it as an object (late bind it). The reason for this is late binding magically finds the current version of excel on the particular machine that is running your code and does it's stuff. Conversley early binding requires the reference that you set for excel (Vba->tools-> references ) on your machine to be the same on every machine that runs your code. If everyone doesn't have the same version the reference will throw a wobbler on the local machine. It's very difficult to code for so the late binding is the way to go.

Dnereb

  • Guest
Re: Find empty cell from Autocad VBA
« Reply #25 on: November 16, 2006, 02:52:16 AM »
Is there anyway to have a macro in either excel or autocad that can look to see how many rows are used and insert based on that number?

If you would store the number of rows in the usedrange.rows.count before the insert ans subtract it from usedrange.rows.count after the insert you will have the number of newly used rows in a sheet.

Early Binding/Late binding (addition to Bryco)

If you set a reference to Excel and use one of the objects in it's library, the layout of the excel object, it's propertie's methodes (in general how it looks) will be hardcoded in your code.
This saves time and intellisense can give a list of all legal possebility's to use of the object your working with.
This is called early binding because this binding the object shape to the code takes place at devolpinging time.
Late binding on the other hand avoids direct reference to the object (including predefined constants in it)
now intellisense can not give legitimate options because it's not "known" what the object will "look" like.
The actual structure will be defined at run time and accessed through COM. (this involves transfering data from two independent proccesses (marshalling) and takes a lot of time) In fact every time you use some part of the late bound object it needs to establish if this (Worksheet for instance) even is an existing property or method because the running code does not have a hard coded map of the excel object in this case.

I hope this will clarify the diffrence between the late and early binding a bit.

Fatty

  • Guest
Re: Find empty cell from Autocad VBA
« Reply #26 on: November 16, 2006, 05:57:10 AM »
Quote
To late bind it replace all Excel.xxxxx to Object end replace Excel constants like XlDown with their corresponding number.
This way the code will run Excel version independent. Note: keep it early bound while developing, it will save you time.
I hate to sound like a complete noob, but what exactly does that mean.  I never understood early vs late binding

This would be interesting for you I think :)

http://www.excelguru.ca/node/10

(about late binding with examples)

~'J'~