Place a large Sub into a Workbook Open Sub

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.

What is the problem with just `Call`ing the macro from `Workbook_Open`? — A.S.H, Dec 02 '16 at 16:14
Not sure if you are asking how to call macros from another macro? — SJR, Dec 02 '16 at 16:15

score 1 · Answer 1 · edited May 23 '17 at 12:08

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!

Thank you for the reply.. Tried what you advised but it gives an error that it does not support the property or method..may be it is because i wrote it exactly as you wrote!9is that what creation point is, or is it referring to the rest of my code).. anyway, here is the whole code!! — Hadiza Hamza, Dec 02 '16 at 21:24
@HadizaHamza Ah, yes. I simply made a wild guess at what your initial macro was. Apparently my `Rand()` function is broken ;) but you can put any `Sub` in there and it should work accordingly. You will just need to figure out what to call and when to call it. — SalvadorVayshun, Dec 02 '16 at 21:46

Place a large Sub into a Workbook Open Sub

1 Answers1