大きなブックをワークブックの開くサブに配置

Question

私は約6つ以上のサブシステムで構成された非常に大きなマクロを持っています。しかし、私はprivate sub workbook_open()にマクロを置くことによって、このマクロ全体を別のアプリケーションから呼び出して、それを自動マクロにしたいと思っています！私が持っている問題は、プライベートサブとエンドサブの境界にこのマクロを配置する方法です。 VBAはプライベートサブは、その中に全体のコードを保持することになっていることをただ一つのコードで宣言のではないということになりますので、基本的にこれはマクロの一部...

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 

大丈夫..ですしてください任意の助けに感謝します。

Answer 1

うまくいけば私は私の編集で質問に答えるのを手伝ったが、私が変更したいと思うことがいくつかある。

1. 変更に代わりSub秒のすべてを置く

2. Private Sub Workbook_Open()には、互いにCallにそれらを使用しています。これは正常に動作するだけでなく、legibleコードをより行います

   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 
   

   ：それは次のようになります

を（コメントでA. S. H.とSJRによって推奨）！これは最優先事項ではありませんが、チームで作業する場合は間違いありません。がんばろう！