Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations IamaSherpa on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

NEED HELP WITH SUBSRIPT OUT OF RANGE ERROR 9

Status
Not open for further replies.
vbcad

vbcad

Technical User
Jul 12, 2002
159
US
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
 
Sort by date Sort by votes
Hi vbcad,

You didn't mention where exactly it was failing, but somewhere you have an array either not properly defined, or you're trying to acccess a part of an array which doesn't exist.

HTH
Todd
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

technobia
  • Locked
  • Question
Need AutoCAD R14 ADI Drivers for GTCO CalComp DrawingBoard VI
Replies
0
Views
187
technobia
technobia
westinsloan72
  • Locked
  • Question
autocad 2013 error 1
Replies
1
Views
528
jacesimmons61
jacesimmons61
kennycad
  • Locked
  • Question
Autocad NET Xdata Get Max Out
Replies
0
Views
167
kennycad
kennycad
tuli01
  • Locked
  • Question
excel 2010 control of Autocad
Replies
1
Views
174
TCARPENTER
TCARPENTER
ronanry
  • Locked
  • Question
Opening DWG file (autocad) into access with activeX
Replies
2
Views
159
ronanry
ronanry

Part and Inventory Search

Sponsor

Back
Top