tHIS ROUTINE IS WAS WORKING AT MY OLD COMPUTER NOW IT WILL NOT. I KEEP GETTING A SUBSCRIPT OUT OF RANGE ERROR. IT WILL SELECT THE BLOCK JUST FINE BUT WHEN IT NEED TO INITILIZE THE USERFORM I GET THE ERROR 9 MESSAGE. BELOW IS THE CODE. ANY HELP I GREAT.
Code:
Public acad As Object
Public doc As Object
Public ms As Object
Public ss As Object
Public ssnew As Object
Public Theatts As Variant
Public MsgBoxResp As Integer
'declare global variables
Sub UpdateAttrib(TagNumber As Integer, BTextString As String)
'This Sub Procedure tests the attribute data to check
'that is not a null value
If BTextString = "" Then
'if the attribute is empty
Theatts(TagNumber).TextString = ""
'put a '-' place holder
Else
'if it is not empty
Theatts(TagNumber).TextString = BTextString
'use the attribute value
End If
End Sub
Private Sub Label1_Click()
End Sub
Private Sub UserForm_Initialize()
Dim BlkG(0) As Integer
Dim TheBlock(0) As Variant
Dim Pt1(0 To 2) As Double
Dim Pt2(0 To 2) As Double
'declare local variables
Set acad = GetObject(, "AutoCAD.Application")
'set reference to AutoCAD
Set doc = acad.ActiveDocument
'set reference to the drawing
Set ms = doc.ModelSpace
'set reference to model space
Set ssnew = doc.SelectionSets.Add("TBLK")
'create a selection set
ssnew.SelectOnScreen
Pt1(0) = 0: Pt1(1) = 0: Pt1(2) = 0
Pt2(0) = 3: Pt2(1) = 3: Pt2(2) = 0
'set up the array
BlkG(0) = 2
'group code 2 for block name
ssnew.Select 5, Pt1, Pt2, BlkG, TheBlock
'get the block
If ssnew.Count >= 1 Then
'if the block is found
Theatts = ssnew.Item(0).GetAttributes
'get the attributes
UserForm1.txt1.Text = UCase(LTrim(Theatts(0).TextString))
'get the title attribute
'clear any leading spaces and
'convert to uppercase
UserForm1.txt0.Text = UCase(LTrim(Theatts(0).TextString))
UserForm1.txt1.Text = UCase(LTrim(Theatts(1).TextString))
UserForm1.txt2.Text = UCase(LTrim(Theatts(6).TextString))
UserForm1.txt3.Text = UCase(LTrim(Theatts(7).TextString))
UserForm1.txt4.Text = UCase(LTrim(Theatts(12).TextString))
UserForm1.txt5.Text = UCase(LTrim(Theatts(13).TextString))
UserForm1.txt6.Text = UCase(LTrim(Theatts(18).TextString))
UserForm1.txt7.Text = UCase(LTrim(Theatts(19).TextString))
UserForm1.txt8.Text = UCase(LTrim(Theatts(24).TextString))
UserForm1.txt9.Text = UCase(LTrim(Theatts(25).TextString))
UserForm1.txt10.Text = UCase(LTrim(Theatts(30).TextString))
UserForm1.txt11.Text = UCase(LTrim(Theatts(31).TextString))
UserForm1.txt12.Text = UCase(LTrim(Theatts(36).TextString))
UserForm1.txt13.Text = UCase(LTrim(Theatts(37).TextString))
UserForm1.txt14.Text = UCase(LTrim(Theatts(2).TextString))
UserForm1.txt15.Text = UCase(LTrim(Theatts(3).TextString))
UserForm1.txt16.Text = UCase(LTrim(Theatts(8).TextString))
UserForm1.txt17.Text = UCase(LTrim(Theatts(9).TextString))
UserForm1.txt18.Text = UCase(LTrim(Theatts(14).TextString))
UserForm1.txt19.Text = UCase(LTrim(Theatts(15).TextString))
UserForm1.txt20.Text = UCase(LTrim(Theatts(20).TextString))
UserForm1.txt21.Text = UCase(LTrim(Theatts(21).TextString))
UserForm1.txt22.Text = UCase(LTrim(Theatts(26).TextString))
UserForm1.txt23.Text = UCase(LTrim(Theatts(27).TextString))
UserForm1.txt24.Text = UCase(LTrim(Theatts(32).TextString))
UserForm1.txt25.Text = UCase(LTrim(Theatts(33).TextString))
UserForm1.txt26.Text = UCase(LTrim(Theatts(38).TextString))
UserForm1.txt27.Text = UCase(LTrim(Theatts(39).TextString))
UserForm1.txt28.Text = UCase(LTrim(Theatts(4).TextString))
UserForm1.txt29.Text = UCase(LTrim(Theatts(5).TextString))
UserForm1.txt30.Text = UCase(LTrim(Theatts(10).TextString))
UserForm1.txt31.Text = UCase(LTrim(Theatts(11).TextString))
UserForm1.txt32.Text = UCase(LTrim(Theatts(16).TextString))
UserForm1.txt33.Text = UCase(LTrim(Theatts(17).TextString))
UserForm1.txt34.Text = UCase(LTrim(Theatts(22).TextString))
UserForm1.txt35.Text = UCase(LTrim(Theatts(23).TextString))
UserForm1.txt36.Text = UCase(LTrim(Theatts(28).TextString))
UserForm1.txt37.Text = UCase(LTrim(Theatts(29).TextString))
UserForm1.txt38.Text = UCase(LTrim(Theatts(34).TextString))
UserForm1.txt39.Text = UCase(LTrim(Theatts(35).TextString))
UserForm1.txt40.Text = UCase(LTrim(Theatts(40).TextString))
UserForm1.txt41.Text = UCase(LTrim(Theatts(41).TextString))
UserForm1.txt1.SetFocus
UserForm1.txt1.SelStart = 0
UserForm1.txt1.SelLength = Len(UserForm1.txt1.Text)
'set the focus to the drawing title and highlight it
Dim xlapp As Excel.Application
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
'declare local variables
Set xlbook = GetObject("C:\E3load1.xls")
'set reference to Excel file
Set xlapp = xlbook.Parent
'set reference to workbook
Set xlsheet = xlbook.Sheets("SHEET1")
'set reference to the worksheet Sheet1
xlsheet.Cells(1, 1) = UserForm1.txt0.Text
xlsheet.Cells(2, 1) = UserForm1.txt1.Text
xlsheet.Cells(3, 1) = UserForm1.txt2.Text
xlsheet.Cells(4, 1) = UserForm1.txt3.Text
xlsheet.Cells(5, 1) = UserForm1.txt4.Text
xlsheet.Cells(6, 1) = UserForm1.txt5.Text
xlsheet.Cells(7, 1) = UserForm1.txt6.Text
xlsheet.Cells(8, 1) = UserForm1.txt7.Text
xlsheet.Cells(9, 1) = UserForm1.txt8.Text
xlsheet.Cells(10, 1) = UserForm1.txt9.Text
xlsheet.Cells(11, 1) = UserForm1.txt10.Text
xlsheet.Cells(12, 1) = UserForm1.txt11.Text
xlsheet.Cells(13, 1) = UserForm1.txt12.Text
xlsheet.Cells(14, 1) = UserForm1.txt13.Text
xlsheet.Cells(1, 2) = UserForm1.txt14.Text
xlsheet.Cells(2, 2) = UserForm1.txt15.Text
xlsheet.Cells(3, 2) = UserForm1.txt16.Text
xlsheet.Cells(4, 2) = UserForm1.txt17.Text
xlsheet.Cells(5, 2) = UserForm1.txt18.Text
xlsheet.Cells(6, 2) = UserForm1.txt19.Text
xlsheet.Cells(7, 2) = UserForm1.txt20.Text
xlsheet.Cells(8, 2) = UserForm1.txt21.Text
xlsheet.Cells(9, 2) = UserForm1.txt22.Text
xlsheet.Cells(10, 2) = UserForm1.txt23.Text
xlsheet.Cells(11, 2) = UserForm1.txt24.Text
xlsheet.Cells(12, 2) = UserForm1.txt25.Text
xlsheet.Cells(13, 2) = UserForm1.txt26.Text
xlsheet.Cells(14, 2) = UserForm1.txt27.Text
xlsheet.Cells(1, 3) = UserForm1.txt28.Text
xlsheet.Cells(2, 3) = UserForm1.txt29.Text
xlsheet.Cells(3, 3) = UserForm1.txt30.Text
xlsheet.Cells(4, 3) = UserForm1.txt31.Text
xlsheet.Cells(5, 3) = UserForm1.txt32.Text
xlsheet.Cells(6, 3) = UserForm1.txt33.Text
xlsheet.Cells(7, 3) = UserForm1.txt34.Text
xlsheet.Cells(8, 3) = UserForm1.txt35.Text
xlsheet.Cells(9, 3) = UserForm1.txt36.Text
xlsheet.Cells(10, 3) = UserForm1.txt37.Text
xlsheet.Cells(11, 3) = UserForm1.txt38.Text
xlsheet.Cells(12, 3) = UserForm1.txt39.Text
xlsheet.Cells(13, 3) = UserForm1.txt40.Text
xlsheet.Cells(14, 3) = UserForm1.txt41.Text
'fill the worksheet cells with the attribute values
UserForm1.totala.Text = xlsheet.Cells(15, 1)
UserForm1.totalb.Text = xlsheet.Cells(15, 2)
UserForm1.totalc.Text = xlsheet.Cells(15, 3)
UserForm1.totalkw.Text = xlsheet.Cells(16, 2)
UserForm1.totalamp.Text = xlsheet.Cells(16, 3)
totalamp.Text = Format(xlsheet.Cells(16, 3), "###0.0")
totalkw.Text = Format(xlsheet.Cells(16, 2), "###0.0")
totalc.Text = Format(xlsheet.Cells(15, 3), "###0.0")
totalb.Text = Format(xlsheet.Cells(15, 2), "###0.0")
totala.Text = Format(xlsheet.Cells(15, 1), "###0.0")
'retrieve the calculated attribute values
xlbook.Close savechanges:=False
'save the changes in Excel
xlapp.Quit
'quit Excel
Set xlsheet = Nothing
Set xlbook = Nothing
Set axlapp = Nothing
'clean up
UpdateAttrib 0, UserForm1.txt0.Text
UpdateAttrib 1, UserForm1.txt1.Text
UpdateAttrib 6, UserForm1.txt2.Text
UpdateAttrib 7, UserForm1.txt3.Text
UpdateAttrib 12, UserForm1.txt4.Text
UpdateAttrib 13, UserForm1.txt5.Text
UpdateAttrib 18, UserForm1.txt6.Text
UpdateAttrib 19, UserForm1.txt7.Text
UpdateAttrib 24, UserForm1.txt8.Text
UpdateAttrib 25, UserForm1.txt9.Text
UpdateAttrib 30, UserForm1.txt10.Text
UpdateAttrib 31, UserForm1.txt11.Text
UpdateAttrib 36, UserForm1.txt12.Text
UpdateAttrib 37, UserForm1.txt13.Text
UpdateAttrib 2, UserForm1.txt14.Text
UpdateAttrib 3, UserForm1.txt15.Text
UpdateAttrib 8, UserForm1.txt16.Text
UpdateAttrib 9, UserForm1.txt17.Text
UpdateAttrib 14, UserForm1.txt18.Text
UpdateAttrib 15, UserForm1.txt19.Text
UpdateAttrib 20, UserForm1.txt20.Text
UpdateAttrib 21, UserForm1.txt21.Text
UpdateAttrib 26, UserForm1.txt22.Text
UpdateAttrib 27, UserForm1.txt23.Text
UpdateAttrib 32, UserForm1.txt24.Text
UpdateAttrib 33, UserForm1.txt25.Text
UpdateAttrib 38, UserForm1.txt26.Text
UpdateAttrib 39, UserForm1.txt27.Text
UpdateAttrib 4, UserForm1.txt28.Text
UpdateAttrib 5, UserForm1.txt29.Text
UpdateAttrib 10, UserForm1.txt30.Text
UpdateAttrib 11, UserForm1.txt31.Text
UpdateAttrib 16, UserForm1.txt32.Text
UpdateAttrib 17, UserForm1.txt33.Text
UpdateAttrib 22, UserForm1.txt34.Text
UpdateAttrib 23, UserForm1.txt35.Text
UpdateAttrib 28, UserForm1.txt36.Text
UpdateAttrib 29, UserForm1.txt37.Text
UpdateAttrib 34, UserForm1.txt38.Text
UpdateAttrib 35, UserForm1.txt39.Text
UpdateAttrib 40, UserForm1.txt40.Text
UpdateAttrib 41, UserForm1.txt41.Text
UpdateAttrib 42, UserForm1.totala.Text
UpdateAttrib 45, UserForm1.totalkw.Text
UpdateAttrib 46, UserForm1.totalamp.Text
UpdateAttrib 43, UserForm1.totalb.Text
UpdateAttrib 44, UserForm1.totalc.Text
'get the attribute values
ssnew.Item(0).Update
'update the attribute block
ssnew.Delete
End
Else
'if no attribute title block is found
MsgBox "Sorry - Panel A not in drawing....", vbCritical, "Nothing to calculate!"
'inform the user that there is no attribute title block
ssnew.Delete
End
'end the application
End If
End Sub