Place a large Sub into a Workbook Open Sub - vba

Question

I have a very large macro that is made up of about 6 or more subs. But i want to call this whole macro from another application by placing the macro in a private sub workbook_open() thereby making it an automatic macro! the problem i have is how do i place this macro with the boundaries of a private sub and end sub. basically this is part of the macro...
Private Sub Workbook_open()
End Sub
'//============================================================================
'// COPYRIGHT DASSAULT SYSTEMES 2001
'//============================================================================
'// Generative Shape Design
'// point, splines, loft generation tool
'//============================================================================
Const Cst_iSTARTCurve As Integer = 1
Const Cst_iENDCurve As Integer = 11
Const Cst_iSTARTLoft As Integer = 2
Const Cst_iENDLoft As Integer = 22
Const Cst_iSTARTCoord As Integer = 3
Const Cst_iENDCoord As Integer = 33
Const Cst_iERRORCool As Integer = 99
Const Cst_iEND As Integer = 9999
Const Cst_strSTARTCurve As String = "StartCurve"
Const Cst_strENDCurve As String = "EndCurve"
Const Cst_strSTARTLoft As String = "StartLoft"
Const Cst_strENDLoft As String = "EndLoft"
Const Cst_strSTARTCoord As String = "StartCoord"
Const Cst_strENDCoord As String = "EndCoord"
Const Cst_strEND As String = "End"
'------------------------------------------------------------------------
'To define the kind of elements to create (1: create only points
'2: creates points and splines
'3: Creates points, splines and loft
'------------------------------------------------------------------------
Function GetTypeFile() As Integer
Dim strInput As String, strMsg As String
choice = 0
While (choice < 1 Or choice > 3)
strMsg = "Type in the kind of entities to create (1 for points, 2 for points and splines, 3 for points, splines and loft):"
strInput = InputBox(Prompt:=strMsg, _
Title:="User Info", XPos:=2000, YPos:=2000)
'Validation of the choice
choice = CInt(strInput)
If (choice < 1 Or choice > 3) Then
MsgBox "Invalid value: must be 1, 2 or 3"
End If
Wend
GetTypeFile = choice
End Function
'------------------------------------------------------------------------
'Get the active cell
'------------------------------------------------------------------------
Function GetCell(iindex As Integer, column As Integer) As String
Dim Chain As String
Sheets("Feuil1").Select
If (column = 1) Then
Chain = "A" + CStr(iindex)
ElseIf (column = 2) Then
Chain = "B" + CStr(iindex)
ElseIf (column = 3) Then
Chain = "C" + CStr(iindex)
End If
Range(Chain).Select
GetCell = ActiveCell.Value
End Function
Function GetCellA(iRang As Integer) As String
GetCellA = GetCell(iRang, 1)
End Function
Function GetCellB(iRang As Integer) As String
GetCellB = GetCell(iRang, 2)
End Function
Function GetCellC(iRang As Integer) As String
GetCellC = GetCell(iRang, 3)
End Function
'------------------------------------------------------------------------
'Syntax of the parameter file
'------------------------
'StartCurve -> to start the list of points defining the spline
' double , double , double
' double , double , double -> as many points as necessary to define the spline
'EndCurve -> to end the list of points defining the spline
'
'
'Example:
'--------
'StartCurve
' -10.89, 10 , 46.78
'1.56, 4, 6
'EndCurve -> spline composed of 2 points
'------------------------------------------------------------------------
Sub ChainAnalysis(ByRef iRang As Integer, ByRef X As Double, ByRef Y As Double, ByRef Z As Double, ByRef iValid As Integer)
Dim Chain As String
Dim Chain2 As String
Dim Chain3 As String
Chain = GetCellA(iRang)
Select Case Chain
Case Cst_strSTARTCurve
iValid = Cst_iSTARTCurve
Case Cst_strENDCurve
iValid = Cst_iENDCurve
Case Cst_strSTARTLoft
iValid = Cst_iSTARTLoft
Case Cst_strENDLoft
iValid = Cst_iENDLoft
Case Cst_strSTARTCoord
iValid = Cst_iSTARTCoord
Case Cst_strENDCoord
iValid = Cst_iENDCoord
Case Cst_strEND
iValid = Cst_iEND
Case Else
iValid = 0
End Select
If (iValid <> 0) Then
Exit Sub
End If
'Conversion string -> double
Chain2 = GetCellB(iRang)
Chain3 = GetCellC(iRang)
If ((Len(Chain) > 0) And (Len(Chain2) > 0) And (Len(Chain3) > 0)) Then
X = CDbl(Chain)
Y = CDbl(Chain2)
Z = CDbl(Chain3)
Else
iValid = Cst_iERRORCool
X = 0#
Y = 0#
Z = 0#
End If
End Sub
'------------------------------------------------------------------------
' Get CATIA Application
'------------------------------------------------------------------------
'Remark:
' When KO, update CATIA registers with:
' CNEXT /unregserver
' CNEXT /regserver
'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Function GetCATIA() As Object
Set CATIA = GetObject(, "CATIA.Application")
If CATIA Is Nothing Then
Set CATIA = CreateObject("CATIA.Application")
CATIA.Visible = True
End If
Set GetCATIA = CATIA
End Function
'------------------------------------------------------------------------
' Get CATIADocument
'------------------------------------------------------------------------
Function GetCATIAPartDocument() As Object
Set CATIA = GetCATIA
Dim MyPartDocument As Object
Set MyPartDocument = CATIA.ActiveDocument
Set GetCATIAPartDocument = MyPartDocument
End Function
'------------------------------------------------------------------------
' Creates all usable points from the parameter file
'------------------------------------------------------------------------
Sub CreationPoint()
'Get CATIA
Dim PtDoc As Object
Set PtDoc = GetCATIAPartDocument
' Get the HybridBody
Dim myHBody As Object
Set myHBody = PtDoc.Part.HybridBodies.Item("GeometryFromExcel")
Dim iLigne As Integer
Dim iValid As Integer
Dim X As Double
Dim Y As Double
Dim Z As Double
Dim Point As Object
iLigne = 1
'Analyze file
While iValid <> Cst_iEND
'Read a line
ChainAnalysis iLigne, X, Y, Z, iValid
iLigne = iLigne + 1
'Not on a startcurve or endcurve -> valid point
If (iValid = 0) Then
Set Point = PtDoc.Part.HybridShapeFactory.AddNewPointCoord(X, Y, Z)
myHBody.AppendHybridShape Point
End If
Wend
'Model update
PtDoc.Part.Update
End Sub
'------------------------------------------------------------------------
' Creates all usable points and splines from the parameter file
'------------------------------------------------------------------------
'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'Limitations:
' ============================> NO MORE THAN 500 POINTS PER SPLINE
'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Sub CreationSpline()
'Limitation : points per spline
Const NBMaxPtParSpline As Integer = 500
'Get CATIA
Dim PtDoc As Object
Set PtDoc = GetCATIAPartDocument
'Get HybridBody
Dim myHBody As Object
Set myHBody = PtDoc.Part.HybridBodies.Item("GeometryFromExcel")
Dim iRang As Integer
Dim iValid As Integer
Dim X1 As Double
Dim Y1 As Double
Dim Z1 As Double
Dim index As Integer
Dim PassingPtArray(1 To NBMaxPtParSpline) As Object
Dim spline As Object
Dim ReferenceOnPoint As Object
Dim SplineCtrPt As Object
iValid = 0
iRang = 1
'Analyze file
While iValid <> Cst_iEND
'reinitialization of point array of the spline
index = 0
'Remove records before StartCurve
While ((iValid <> Cst_iSTARTCurve) And (iValid <> Cst_iEND))
ChainAnalysis iRang, X1, Y1, Z1, iValid
iRang = iRang + 1
Wend
If (iValid <> Cst_iEND) Then
'Read until endcurve -> Spline completed
While ((iValid <> Cst_iENDCurve) And (iValid <> Cst_iEND))
ChainAnalysis iRang, X1, Y1, Z1, iValid
iRang = iRang + 1
'valid point
If (iValid = 0) Then
index = index + 1
If (index > NBMaxPtParSpline) Then
MsgBox "Too many points for a spline. Point deleted"
Else
Set PassingPtArray(index) = PtDoc.Part.HybridShapeFactory.AddNewPointCoord(X1, Y1, Z1)
myHBody.AppendHybridShape PassingPtArray(index)
End If
End If
Wend
'Start building spline
'Are there enough points ?
If (index < 2) Then
MsgBox "Not enough points for a spline. Spline deleted"
Else
Set spline = PtDoc.Part.HybridShapeFactory.AddNewSpline
spline.SetSplineType 0
spline.SetClosing 0
'Creates and adds points to the spline
For i = 1 To index
Set ReferenceOnPoint = PtDoc.Part.CreateReferenceFromObject(PassingPtArray(i))
' ---- Version Before V5R12
' Set SplineCtrPt = PtDoc.Part.HybridShapeFactory.AddNewControlPoint(ReferenceOnPoint)
' spline.AddControlPoint SplineCtrPt
' ---- Since V5R12
spline.AddPointWithConstraintExplicit ReferenceOnPoint, Nothing, -1, 1, Nothing, 0
Next i
myHBody.AppendHybridShape spline
End If
End If
Wend
PtDoc.Part.Update
End Sub
Sub LookForNextSpline(ByRef iRang As Integer, ByRef spline As Object, ByRef iValid As Integer, ByRef iOKSpline)
'Limitation number off point per spline
Const NBMaxPtParSpline As Integer = 500
'Get CATIA
Dim PtDoc As Object
Set PtDoc = GetCATIAPartDocument
'Get HybridBody
Dim myHBody As Object
Set myHBody = PtDoc.Part.HybridBodies.Item("GeometryFromExcel")
Dim X1 As Double
Dim Y1 As Double
Dim Z1 As Double
Dim index As Integer
Dim PassingPtArray(1 To NBMaxPtParSpline) As Object
Dim ReferenceOnPoint As Object
Dim SplineCtrPt As Object
iValid = 0
iOKSpline = 0
'reinitialization of point array of the spline
index = 0
'Remove records before StartCurve
While ((iValid <> Cst_iSTARTCurve) And (iValid <> Cst_iEND))
ChainAnalysis iRang, X1, Y1, Z1, iValid
iRang = iRang + 1
Wend
If (iValid <> Cst_iEND) Then
'Read until endcurve -> Spline completed
While ((iValid <> Cst_iENDCurve) And (iValid <> Cst_iEND))
ChainAnalysis iRang, X1, Y1, Z1, iValid
iRang = iRang + 1
'valid point
If (iValid = 0) Then
index = index + 1
If (index > NBMaxPtParSpline) Then
MsgBox "Too many points for a spline. Point deleted"
Else
Set PassingPtArray(index) = PtDoc.Part.HybridShapeFactory.AddNewPointCoord(X1, Y1, Z1)
myHBody.AppendHybridShape PassingPtArray(index)
End If
End If
Wend
'Start building spline
'Are there enough points ?
If (index < 2) Then
MsgBox "Not enough points for a spline. Spline deleted"
Else
Set spline = PtDoc.Part.HybridShapeFactory.AddNewSpline
'Creates and adds points to the spline
For i = 1 To index
Set ReferenceOnPoint = PtDoc.Part.CreateReferenceFromObject(PassingPtArray(i))
' ---- Version Before V5R12
' Set SplineCtrPt = PtDoc.Part.HybridShapeFactory.AddNewControlPoint(ReferenceOnPoint)
' spline.AddControlPoint SplineCtrPt
' ---- Since V5R12
spline.AddPointWithConstraintExplicit ReferenceOnPoint, Nothing, -1, 1#, Nothing, 0#
Next i
myHBody.AppendHybridShape spline
spline.SetSplineType 0
spline.SetClosing 0
iOKSpline = 1
End If
End If
End Sub
okay so VBA takes it that private sub is just one of the declarations in the code not that it is supposed to hold the whole code within it.. please any help will be appreciated.

Answer 1

Hopefully I helped answer the question with my edits, but there are a couple things I would change, and suggest.
Change Private Sub Workbook_open() to Private Sub Workbook_Open()
Instead of putting all of the Subs into one Private Sub, use them to Call each other. (Suggested by A. S. H. and SJR in comments)
It would look something like this:
Const Cst_iSTARTCurve As Integer = 1
Const Cst_iENDCurve As Integer = 11
Const Cst_iSTARTLoft As Integer = 2
Const Cst_iENDLoft As Integer = 22
Const Cst_iSTARTCoord As Integer = 3
Const Cst_iENDCoord As Integer = 33
Const Cst_iERRORCool As Integer = 99
Const Cst_iEND As Integer = 9999
Const Cst_strSTARTCurve As String = "StartCurve"
Const Cst_strENDCurve As String = "EndCurve"
Const Cst_strSTARTLoft As String = "StartLoft"
Const Cst_strENDLoft As String = "EndLoft"
Const Cst_strSTARTCoord As String = "StartCoord"
Const Cst_strENDCoord As String = "EndCoord"
Const Cst_strEND As String = "End"
Private Sub Workbook_Open()
CreationPoint
'or Call CreationPoint
End Sub
This will not only work normally, but will also make your code more legible! Though this isn't the top priority, it will definitely help when working in teams. Good luck!