I am getting a vba error when running the Xacto Section tutorial. Error is when prompted to add the new view frame (below; line 9 that an object is required). Have no idea what the "arcid.pagelayout_newmap" is doing here, but cannot figure out what to change it to work. From what I understand this should be pointing to the toolbar.Private Sub cmdYes_Click()
'add a new data frame
Dim pCommandBars As ICommandBars
Set pCommandBars = ThisDocument.CommandBars
Dim pCommandItem As ICommandItem
Set pCommandItem = pCommandBars.Find(arcID.pagelayout_newmap)
pCommandItem.Execute
Dim pMxDoc As IMxDocument
Set pMxDoc = ThisDocument
Dim pMap As IMap
Set pMap = pMxDoc.FocusMap
pMap.Name = Form1.txtXsecName & " Profile"
Dim pLayer As ILayer
Dim pFLayer As IFeatureLayer
'open the workspace where the new shapefiles are located
Dim pWorkspaceFactory As IWorkspaceFactory
Set pWorkspaceFactory = New ShapefileWorkspaceFactory
Dim pWorkspace As IWorkspace
Set pWorkspace = pWorkspaceFactory.OpenFromFile(Form1.txtWorkspace.value, 0)
Dim pFeatureWS As IFeatureWorkspace
Set pFeatureWS = pWorkspace
'make a list of the shapefiles to be added
Dim XsecName As String
XsecName = Form1.txtXsecName.value
Dim colNewShapes As Collection
Set colNewShapes = New Collection
If Form1.cbGrid.value = True Then
colNewShapes.Add XsecName & "_GridLine"
End If
If Form1.ListBox1.ListCount >= 1 Then
For h = 0 To Form1.ListBox1.ListCount - 1
colNewShapes.Add XsecName & "_" & Form1.ListBox1.List(h, 1)
Next h
End If
If Form1.cbProfile = True Then
colNewShapes.Add XsecName & "_profile"
End If
If Form1.cbDepthData.value = True And QuitWellln = False Then
colNewShapes.Add XsecName & "_wellln"
End If
If Form1.cbWells.value = True And QuitPts = False Then
If frmPoints.cbExtrude = True Then
colNewShapes.Add XsecName & "_depths"
End If
If Form1.cbGeoPhys.value = True Then
colNewShapes.Add XsecName & "_geophys"
End If
colNewShapes.Add XsecName & "_wellpt"
End If
If Form1.cbGeoContacts = True Then 'add the shapefile to the map
colNewShapes.Add XsecName & "_geopts"
End If
Dim pFClass1000 As IFeatureClass
For i = 1 To colNewShapes.Count
Set pFClass1000 = pFeatureWS.OpenFeatureClass(colNewShapes.Item(i))
Set pFLayer = New FeatureLayer
Set pFLayer.FeatureClass = pFClass1000
Set pLayer = pFLayer
pLayer.Name = pFClass1000.AliasName
pMap.AddLayer pLayer
Next i
Dim j As Integer
For i = 1 To pMap.LayerCount
Set pLayer = pMap.Layer(i - 1)
j = i - 1
If pLayer.Name = Form1.txtXsecName.value & "_profile" Then
If Form1.cbGeoContacts.value = True Then
Call Module1.Render("Abbrev", j)
Call frmDataFrame.LabelLines(pLayer.Name, "[Abbrev]", 0, 6)
End If
ElseIf pLayer.Name = Form1.txtXsecName.value & "_wellln" Then
Call Module1.Render("Geo", j)
Call frmDataFrame.LabelLines(pLayer.Name, "[Geo]", 7, 0)
ElseIf pLayer.Name = Form1.txtXsecName.value & "_geopts" Then
Call frmDataFrame.RenderPoints("Diamond 1", j)
ElseIf pLayer.Name = Form1.txtXsecName.value & "_wellpt" Then
Call frmDataFrame.RenderPoints("Cross 1", j)
Call frmDataFrame.RotateField
Call frmDataFrame.LabelWells
End If
Next i
frmDataFrame.Hide
End Sub
