wordreports.bas

c#设计模式WithCla

Attribute VB_Name = "WordReports"
Option Explicit
Option Base 1      'All array indexes start with 1
'(c) 1993-1998 MicroGold Software, Inc.
'Set Tools-Options-Editor All Boxes Checked
'Set Tools-Options-General Break On All Errors

Private wcDocument As With_Class.Document
Private sMsg As String
Private iFileID As Integer

Sub WordCreateClassReport()
  On Error GoTo ErrorHandler
    Dim numClasses As Long
    Dim oTable As Object
    Dim oCell As Object
    Dim h As Integer
    Dim I As Integer
    Dim j As Integer
    Dim k As Integer
    Dim l As Integer
   
    Dim m As Integer
    Dim iParameterCount As Integer
    Dim iCounter As Integer
    Dim iAttrCounter As Integer
    Dim iOperCounter As Integer
    Dim iRelCounter As Integer
    Dim iIncludeCounter As Integer
    
    Dim currentAttribute As Object
    Dim currentOperation As Object
    Dim currentClass As Object
    Dim CurrentRelation As Object
    Dim currentBaseClass As Object
    Dim CurrentAggregationClass As Object
    Dim CurrentAssociationClass As Object
    
    Dim AttributeList As Object
    Dim OperationList As Object
    Dim ClassList As With_Class.Classes
    Dim RelationList As Object
    Dim BaseClassList As Object
    Dim AggregationClassList As Object
    Dim AssociationClassList As Object
    Dim sFileName As String
    Dim sInfile As String
    Dim sCellNum As String
    Dim iRowCount As Integer
    Dim iColCount As Integer
    Dim myRange As Object
    
' ***********Word Variables***************
Dim ThisWord As Word.Application
Dim newDoc As Object
Dim aRange As Word.Range
Dim TitleArray As Variant
Dim DataArray As Variant
' ****************************************
   
   iFileID = FreeFile
   iRowCount = 2
   sFileName = "c:\report.txt"

Dim iCount As Integer
    
Set wcDocument = ActiveDocument

TitleArray = Array("Name", "Description", "Package", "Stereotype", "Visibility", "ImportFile", "LibraryBaseClass")
Set ThisWord = CreateObject("Word.application")

ThisWord.DefaultSaveFormat = "HTML"
ThisWord.Visible = True

Set newDoc = ThisWord.Documents.Add
With newDoc
    .Content.Font.Name = "Arial"
    .PageSetup.Orientation = wdOrientLandscape
    

Set ClassList = wcDocument.Classes
numClasses = ClassList.Count

 .Tables.Add Range:=.Range(Start:=0, End:=0), NumRows:=numClasses + 1, NumColumns:=5
Set oTable = .Tables.Item(1)
Set aRange = newDoc.Range(Start:=0, End:=0)
' Set oTable = newDoc.Tables.Add(Range:=aRange, NumRows:=numClasses, NumColumns:=5)
    iCount = 1

 oTable.AutoFormat Format:=wdTableFormatColorful2, _
    ApplyBorders:=True, ApplyFont:=True, ApplyColor:=True
    
 oTable.Columns(1).Width = InchesToPoints(1.5)
 oTable.Columns(2).Width = InchesToPoints(3)
 oTable.Columns(3).Width = InchesToPoints(1)
 oTable.Columns(4).Width = InchesToPoints(0.5)
 oTable.Columns(5).Width = InchesToPoints(0.5)

 oTable.Cell(1, 1).Range.InsertAfter "Name"
 oTable.Cell(1, 2).Range.InsertAfter "Description"
 oTable.Cell(1, 3).Range.InsertAfter "Stereotype"
 oTable.Cell(1, 4).Range.InsertAfter "# attributes"
 oTable.Cell(1, 5).Range.InsertAfter "# Operations"

 iCounter = ClassList.Count
 ClassList.Restart
      iColCount = 2
      While (ClassList.IsLast = False)
        Set currentClass = ClassList.GetNext
        oTable.Cell(row:=iColCount, Column:=1).Range.InsertAfter currentClass.Name
        oTable.Cell(row:=iColCount, Column:=2).Range.InsertAfter currentClass.Description
        oTable.Cell(row:=iColCount, Column:=3).Range.InsertAfter currentClass.Stereotype
        oTable.Cell(row:=iColCount, Column:=4).Range.InsertAfter currentClass.Attributes.Count
        oTable.Cell(row:=iColCount, Column:=5).Range.InsertAfter currentClass.Operations.Count
        iColCount = iColCount + 1
      Wend
      
wcDocument.CopyRegionToClipBoard 0, 0, 500, 500
ThisWord.Selection.Paste
       
      ClassList.Restart
      While (ClassList.IsLast = False)
         Set currentClass = ClassList.GetNext
         GenerateAttributePage currentClass, newDoc
         GenerateOperationPage currentClass, newDoc
      Wend
        
    '.Save
    '.Close
    End With
 MsgBox ("Finished generating table")
 ' ThisWord.Quit
Exit Sub
ErrorHandler:
   sMsg = "Error # " & Str(Err.Number) & " was generated by " & Err.Source & Chr(13) & Err.Description
   MsgBox sMsg, , "Error", Err.HelpFile, Err.HelpContext
  
End Sub
Private Sub GenerateAttributePage(aClass As Object, aDoc As Object)

On Error GoTo ErrorHandler
    Dim sMsg As String
    Dim AttributeList As Object
    Dim currentAttribute As Object
    Dim oTable As Object
    Dim oCell As Object
    Dim sCellNum As String
    Dim iRowCount As Integer
    Dim iColCount As Integer
    Dim myRange As Object
    Dim iCount As Integer
    Dim iCounter As Integer

    Set myRange = aDoc.Sections.Last.Range
    myRange.SetRange Start:=myRange.End + 10, End:=myRange.End + 20

    myRange.InsertBreak Type:=wdSectionBreakNextPage

    myRange.InsertAfter Text:="Class Attributes of " + aClass.Name
    myRange.SetRange Start:=myRange.End + 100, End:=myRange.End + 110

    Set AttributeList = aClass.Attributes

    Set oTable = aDoc.Tables.Add(Range:=myRange, NumRows:=AttributeList.Count + 1, _
    NumColumns:=5)
    iCount = 1

    oTable.AutoFormat Format:=wdTableFormatColorful2, _
    ApplyBorders:=True, ApplyFont:=True, ApplyColor:=True
    
    oTable.Columns(1).Width = InchesToPoints(1.5)
    oTable.Columns(2).Width = InchesToPoints(1.5)
    oTable.Columns(3).Width = InchesToPoints(3)
    oTable.Columns(4).Width = InchesToPoints(1.5)
    oTable.Columns(5).Width = InchesToPoints(0.5)

    oTable.Cell(1, 1).Range.InsertAfter "Name"
    oTable.Cell(1, 2).Range.InsertAfter "Type"
    oTable.Cell(1, 3).Range.InsertAfter "Description"
    oTable.Cell(1, 4).Range.InsertAfter "Initial Value"
    oTable.Cell(1, 5).Range.InsertAfter "IsStatic"

    iCounter = AttributeList.Count
    
    AttributeList.Restart
    iColCount = 2
    While (AttributeList.IsLast = False)
       Set currentAttribute = AttributeList.GetNext
       oTable.Cell(row:=iColCount, Column:=1).Range.InsertAfter currentAttribute.Name
       oTable.Cell(row:=iColCount, Column:=2).Range.InsertAfter currentAttribute.Type
       oTable.Cell(row:=iColCount, Column:=3).Range.InsertAfter currentAttribute.Description
       oTable.Cell(row:=iColCount, Column:=4).Range.InsertAfter currentAttribute.InitialValue
       oTable.Cell(row:=iColCount, Column:=5).Range.InsertAfter currentAttribute.IsStatic
       iColCount = iColCount + 1
     Wend
Exit Sub
ErrorHandler:
   sMsg = "Error # " & Str(Err.Number) & " was generated by " & Err.Source & Chr(13) & Err.Description
   MsgBox sMsg, , "Error", Err.HelpFile, Err.HelpContext
 
End Sub
Private Sub GenerateOperationPage(aClass As Object, aDoc As Object)
On Error GoTo ErrorHandler
    Dim sMsg As String
    Dim OperationList As Object
    Dim currentOperation As Object
    Dim oTable As Object
    Dim oCell As Object
    Dim sCellNum As String
    Dim iRowCount As Integer
    Dim iColCount As Integer
    Dim myRange As Object
    Dim iCount As Integer
    Dim iCounter As Integer

    Set myRange = aDoc.Sections.Last.Range
    myRange.SetRange Start:=myRange.End + 10, End:=myRange.End + 20

    myRange.InsertBreak Type:=wdSectionBreakNextPage

    myRange.InsertAfter Text:="Class Operations of " + aClass.Name
    myRange.SetRange Start:=myRange.End + 100, End:=myRange.End + 110

    Set OperationList = aClass.Operations

    Set oTable = aDoc.Tables.Add(Range:=myRange, NumRows:=OperationList.Count + 1, _
    NumColumns:=5)