Need help with some code involving Excel

[Anonymous]

The following code is the code i have for opening an existing excel spreadsheet, and the other sub after is for putting data into excel. However I continue to get a "Runtime - error "424" Object Required" error for whichever listindex i choose. I have surrounded the code with error in *'s. Is this possibly something to do with my excel open code being wrong? or am i just missing something?

Private Sub OpenExcel_Click()
Dim oExcel As Excel.Application
Dim oBook As Excel.Workbook
Dim oSheet As Excel.Worksheet

'Open Excel
Set oExcel = New Excel.Application
oExcel.Visible = True


Set oBook = oExcel.Workbooks.Add("\\fscs\Students\curtisno\Desktop\217ExcelCost.xls")

Set oSheet = oBook.Sheets("UnitCosts")

oExcel.DisplayAlerts = False
'Save new file
'-------------
Dim ExcelFileName As String
Dim msg1 As Variant
'open SaveAs dialog
CommonDialog1.ShowSave

'define the name for new file. When Save button is clicked, new file is created and saved.
ExcelFileName = CommonDialog1.FileName

'just the note for user if Cancel button is clicked
If ExcelFileName = "" Then
msg1 = MsgBox("You didn't create a file.", vbOKOnly, "Note")
Exit Sub
End If
'-------------------
'Call oBook.Close(True, "C:\myFile1.xls")
Call oBook.Close(True, ExcelFileName)
oExcel.DisplayAlerts = True
oExcel.Quit

Set oSheet = Nothing
Set oBook = Nothing
Set oExcel = Nothing
End Sub


Private Sub ExteriorGet_Click()

Dim pt1, pt2 As Variant
Dim objPline As AcadLWPolyline
Dim Points() As Double
Dim distanceEXT As Double
Dim areaEXT As Double
UserForm1.Hide
On Error Resume Next
pt1 = ThisDrawing.Utility.GetPoint(, "Enter First Point")
If Err.Number <> 0 Then Exit Sub
ReDim Points(1)
Points(0) = pt1(0): Points(1) = pt1(1)
i = 1
Do
pt2 = ThisDrawing.Utility.GetPoint(pt1, "Enter Next Point")
If Err.Description <> "User input is a keyword" Then
i = i + 2
ReDim Preserve Points(i)
Points(i - 1) = pt2(0)
Points(i) = pt2(1)
objPline.Delete
Set objPline = ThisDrawing.ModelSpace.AddLightWeightPolyline(Points)
objPline.Update
pt1 = pt2
Else
Exit Do
End If
Loop

distanceEXT = objPline.Length
areaEXT = objPline.Area
objPline.Delete
distanceEXTa = distanceEXT
areaEXTa = areaEXT
UserForm1.Show

On Error GoTo 0

If FoundationTypeBox.ListIndex = 0 Then
oSheet.Cells(3, 4).Value = (Worksheet.Cells(3, 4).Value + distanceEXT)
ElseIf FoundationTypeBox.ListIndex = 1 Then
oSheet.Cells(4, 4).Value = (Worksheet.Cells(4, 4).Value + distanceEXT)
ElseIf FoundationTypeBox.ListIndex = 2 Then
oSheet.Cells(5, 4).Value = (Worksheet.Cells(5, 4).Value + distanceEXT)
Else: MsgBox "No Foundation Type Selected."
End If

If FloorSlabBox.ListIndex = 0 Then
oSheet.Cells(7, 4).Value = (Worksheet.Cells(7, 4).Value + areaEXT)
ElseIf FloorSlabBox.ListIndex = 1 Then
oSheet.Cells(8, 4).Value = (Worksheet.Cells(8, 4).Value + areaEXT)
ElseIf FloorSlabBox.ListIndex = 2 Then
oSheet.Cells(9, 4).Value = (Worksheet.Cells(9, 4).Value + areaEXT)
Else: MsgBox "No Floor Slab Selected."
End If

If ExteriorWallBox.ListIndex = 0 Then
oSheet.Cells(11, 4).Value = (Worksheet.Cells(11, 4).Value + distanceEXT)
ElseIf ExteriorWallBox.ListIndex = 1 Then
oSheet.Cells(12, 4).Value = (Worksheet.Cells(12, 4).Value + distanceEXT)
ElseIf ExteriorWallBox.ListIndex = 2 Then
oSheet.Cells(13, 4).Value = (Worksheet.Cells(13, 4).Value + distanceEXT)
Else: MsgBox "No Exterior Wall Selected."
End If

If RoofStructureBox.ListIndex = 0 Then
oSheet.Cells(52, 4).Value = (Worksheet.Cells(52, 4).Value + areaEXT)
ElseIf RoofStructureBox.ListIndex = 1 Then
oSheet.Cells(53, 4).Value = (Worksheet.Cells(53, 4).Value + areaEXT)
Else: MsgBox "No Roof Structure Selected."
End If

If RoofMaterialsBox.ListIndex = 0 Then
oSheet.Cells(55, 4).Value = (Worksheet.Cells(55, 4).Value + areaEXT)
ElseIf RoofMaterialsBox.ListIndex = 1 Then
oSheet.Cells(56, 4).Value = (Worksheet.Cells(56, 4).Value + areaEXT)
ElseIf RoofMaterialsBox.ListIndex = 2 Then
oSheet.Cells(57, 4).Value = (Worksheet.Cells(57, 4).Value + areaEXT)
ElseIf RoofMaterialsBox.ListIndex = 3 Then
oSheet.Cells(58, 4).Value = (Worksheet.Cells(58, 4).Value + areaEXT)
Else: MsgBox "No Roof Materials Selected."
End If

End Sub

[Anonymous]

sorry the error code is...

oSheet.Cells(3, 4).Value = (Worksheet.Cells(3, 4).Value + distanceEXT)

depending on which listindex i choose, there is an error reguardless just the selected line of code

[Anonymous]

I'm not certain of it, but the line you cited below looks like it should be:

oSheet.Cells(3, 4).Value = oSheet.Cells(3, 4).Value + distanceEXT

or possibly (among others):

ActiveSheet.Cells(3, 4).Value = ActiveSheet.Cells(3, 4).Value + distanceEXT

You shouldn't be using "WorkSheet" as a variable if that's what you're
trying to do. VBA keywords, method & property names etc should be off limits
for variable names.

>>oSheet.Cells(3, 4).Value = (Worksheet.Cells(3, 4).Value + distanceEXT)

>>depending on which listindex i choose, there is an error reguardless just
the selected line of code

[Anonymous]

sorry, i was changing variable names and forgot to switch that part out, but the same error resides reguardless as the label was not the problem. any thoughts on why this is? i assume still that is a problem with my linking to excel code and not inserting the values?

[Anonymous]

Try connecting using "CreateObject" and/or "GetObject" to see if that makes
a difference.

[Anonymous]

'测量面积
Function CalculateDefinedArea()
Dim j As Integer
Dim j1 As Integer
Dim i As Integer
Dim p1 As Variant
Dim jp(0 To 2) As Double
Dim p2(200) As Double
Dim p3() As Double
Dim Line1(200) As AcadLine

AppActivate AcadApp.Caption '换到CAD窗体

' 获取用户输入的点
j1 = 0
Do

If j1 = 0 Then

On Error Resume Next
p1 = AcadApp.ActiveDocument.Utility.GetPoint(, "测量面积功能,请选取第" & j1 + 1 & "点: ")
If Err Then
Err.Clear
Exit Function
End If
ElseIf j1 = 1 Then

On Error Resume Next
p1 = AcadApp.ActiveDocument.Utility.GetPoint(p1, "测量面积功能,请选取第" & j1 + 1 & "点: ")
If Err Then
Err.Clear
Exit Function
End If

Else

On Error Resume Next
p1 = AcadApp.ActiveDocument.Utility.GetPoint(p1, "测量面积功能,请选取第" & j1 + 1 & "点: ")
If Err Then
Err.Clear
Exit Do
End If

End If
p2(j) = p1(0)
p2(j + 1) = p1(1)


If j1 > 0 Then
Set Line1(j1) = AcadApp.ActiveDocument.ModelSpace.AddLine(p1, jp)
Line1(j1).Color = acBlue
Line1(j1).Lineweight = acLnWt050
Line1(j1).Update
End If
jp(0) = p1(0)
jp(1) = p1(1)
jp(2) = p1(2)
j = j + 2
j1 = j1 + 1
Loop

'ReDim line1(j1) As AcadLine
For i = 1 To j1
Line1(i).Delete
Next



' 根据这些点创建二维多段线
Dim polyObj As AcadLWPolyline
ReDim p3(0 To (j - 1)) As Double

For i = 0 To j - 1
p3(i) = p2(i)
Next i



Set polyObj = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(p3)
polyObj.Closed = True
polyObj.Color = acGreen
polyObj.Lineweight = acLnWt060
polyObj.Highlight (True)

' 显示多段线的面积
'MsgBox "The area defined by the points is " & _
' polyObj.Area, , "Calculate Defined Area"
mianji = Int(polyObj.Area * 0.0001) * 0.01
'Form3.Visible = True
' Form3.Label1.Caption = "面积计算" & mianji

AppActivate AcadApp.Caption '换到CAD窗体

If Form1.Check1.Value = 1 Then
Dim NewLayer As AcadLayer
Set NewLayer = AcadApp.ActiveDocument.Layers.Add("mianji")
AcadApp.ActiveDocument.ActiveLayer = NewLayer
'文字
' Dim styobj1 As AcadTextStyle
' Set styobj1 = AcadApp.ActiveDocument.TextStyles.Add("设计")
' typeface = "宋体"
'定义文本对象
Dim textobj As AcadText
'Dim textstring As String
'Dim insertionpoint(0 To 2) As Double
Dim height As Double
Dim blockObj As AcadBlock
height = 200
If Form1.Check7.Value = 0 Then
Form1.StatusBar1.Panels(1).Text = "请选择面积数: """ & mianji & "平方米"" 标注位置"






Dim insertionPnt(0 To 2) As Double
insertionPnt(0) = 0
insertionPnt(1) = 0
insertionPnt(2) = 0
Set blockObj = AcadApp.ActiveDocument.Blocks.Add(insertionPnt, "text2")

' 向块中添加圆
Set textobj = blockObj.AddText(mianji & "m2", insertionPnt, height)
AcadBlock11 blockObj
AcadApp.ActiveDocument.SendCommand "_EXPLODE " & "L " & vbCr 'Explode last item
Else
p1(0) = (p3(0) + p3(4)) * 0.5 - 600
p1(1) = (p3(1) + p3(5)) * 0.5 - 600
p1(2) = 0
Set textobj = AcadApp.ActiveDocument.ModelSpace.AddText(Str(mianji) & "平方米", p1, height)
textobj.Update

End If

End If




polyObj.Delete
End Function

do like this is right
TempSheet1.Cells(hj, 1) = hj 'hj string

TempSheet1.Cells(hj, 3) = List2.List(List2.ListIndex)
TempSheet1.Cells(hj, 4) = List3.List(List3.ListIndex)
TempSheet1.Cells(hj, 5) = List1.List(List1.ListIndex)
TempSheet1.Cells(hj, 6) = List4.List(List4.ListIndex)
TempSheet1.Cells(hj, 7) = Text1.Text
TempSheet1.Cells(hj, 8) = Text3.Text
TempSheet1.Cells(hj, 9) = Text4.Text