I am trying to run a piece of code in the VB editor to make it loop through each page of an Excel workbook, but for the reason that I am no VB expert I cannot get it to work, can anyone please help me. I have pasted the code below, I feel that someone with good VB knowledge could solve this in a minute or two. Many Thanks
Option Explicit
Private oExcel As Excel.Application
Private oSheet As Excel.WorkSheet
Private oPartDoc As PartDocument
Private Sub CloseSpline_Click()
End Sub
Private Sub ColumnX_Change()
End Sub
Private Sub ColumnZ_Change()
End Sub
Private Sub UserForm_Initialize()
Set oPartDoc = ThisApplication.ActiveDocument
Set oExcel = GetObject(, "Excel.Application")
Set oSheet = oExcel.ActiveSheet
End Sub
Private Sub UserForm_Terminate()
Set oPartDoc = Nothing
Set oExcel = Nothing
Set oSheet = Nothing
End Sub
Private Sub Create3DSpline_Click()
If Create3DSpline.Value = True Then
Createpolyline.Value = False
CloseSpline.Enabled = True
Createpolyline.Value = False
Else
CloseSpline.Enabled = False
Createpolyline.Value = True
End If
End Sub
Private Sub CreatePolyline_Click()
If Createpolyline.Value = True Then
Create3DSpline.Value = False
CloseSpline.Enabled = False
Closepolyline.Enabled = True
Else
Closepolyline.Enabled = False
Create3DSpline.Value = True
End If
End Sub
Private Sub OKButton_Click()
Dim j As Integer
Dim xSheet As String
For j = 1 To 10
Dim bCreateSpline As Boolean
Dim bCreatePolyline As Boolean
bCreateSpline = Create3DSpline.Value
bCreatePolyline = Createpolyline.Value
Dim bCloseSpline As Boolean
bCloseSpline = CloseSpline.Value
Dim bClosePolyline As Boolean
bClosePolyline = Closepolyline.Value
ThisApplication.UserInterfaceManager.UserInteractionDisabled = True
Dim oDef As PartComponentDefinition
Set oDef = oPartDoc.ComponentDefinition
Dim oPoints As ObjectCollection
Set oPoints = ThisApplication.TransientObjects.CreateObjectCollection
Dim oUsedRange As Range
Set oUsedRange = oSheet.UsedRange
Dim oRowCount As Long
oRowCount = oSheet.Range("A65536").End(xlUp).Row
Dim i As Integer
For i = 1 To oRowCount
Dim strx As String, stry As String, strz As String
strx = oUsedRange.Cells(i, CInt(ColumnX.Text))
stry = oUsedRange.Cells(i, CInt(ColumnY.Text))
strz = oUsedRange.Cells(i, CInt(ColumnZ.Text))
Dim x As Double, y As Double, z As Double
x = oPartDoc.UnitsOfMeasure.GetValueFromExpression(strx, kDatabaseLengthUnits)
y = oPartDoc.UnitsOfMeasure.GetValueFromExpression(stry, kDatabaseLengthUnits)
z = oPartDoc.UnitsOfMeasure.GetValueFromExpression(strz, kDatabaseLengthUnits)
Dim oPoint As Point
Set oPoint = ThisApplication.TransientGeometry.CreatePoint(x, y, z)
Dim oWorkPoint As WorkPoint
Set oWorkPoint = oDef.WorkPoints.AddFixed(oPoint)
Call oWorkPoint.AttributeSets.Add("ImportedFromExcel").Add("Index", kIntegerType, i)
oPoints.Add oWorkPoint
Next
Dim oClientFeatures As ClientFeatures
Set oClientFeatures = oDef.Features.ClientFeatures
'Create a client feature definition by adding the selected items
Dim oClientFeatureDef As ClientFeatureDefinition
Set oClientFeatureDef = oClientFeatures.CreateDefinition("Imported Work Points", oPoints.Item(1), oPoints.Item(oPoints.Count))
Dim oCFE As ClientFeatureElement
For Each oCFE In oClientFeatureDef.ClientFeatureElements
oCFE.BrowserVisible = True
oCFE.UserEditable = True
oCFE.HighlightWithFeature = False
Next
' Create the client feature
Dim oClientFeature As ClientFeature
Set oClientFeature = oClientFeatures.Add(oClientFeatureDef, "ImportedWorkPointsClientId")
Dim oSketch3D As Sketch3D
Set oSketch3D = oDef.Sketches3D.Add
If bCreateSpline Then
Dim oSpline As SketchSpline3D
Set oSpline = oSketch3D.SketchSplines3D.Add(oPoints)
If bCloseSpline Then
oSpline.closed = True
End If
End If
If bCreatePolyline Then
For i = 1 To oPoints.Count - 1
Call oSketch3D.SketchLines3D.AddByTwoPoints(oPoints(i), oPoints(i + 1), False)
Next
If bClosePolyline Then
Call oSketch3D.SketchLines3D.AddByTwoPoints(oPoints(oPoints.Count), oPoints(1), False)
End If
End If
Set oSpline = Nothing
Set oSketch3D = Nothing
ThisApplication.UserInterfaceManager.UserInteractionDisabled = False
ThisApplication.ActiveView.Fit
Unload Me
xSheet = "Sheet" & j
Sheets(xSheet).Select
Next j
End Sub
Private Sub CancelButton_Click()
Unload Me
ThisApplication.UserInterfaceManager.UserInteractionDisabled = False
End Sub