'MACRO TITLE: Report Logical or Physical Model TO Microsoft Word
'This macro generates a mini report for the selected entities in the active model. ' REQUIREMENT: Y ou must have Word 97 or later installed.
Sub Main
'Dim MS Word variables
Dim Word As Object
Dim Docs As Object
Dim ActiveDoc As Object
'Dim ER/Studio variables.
Dim diag As Diagram
Dim mdl As Model
Dim subMdl As SubModel
Dim ent As Entity
Dim attr As AttributeObj
Dim tableConstraints As TableCheckConstraints
Dim tableConstraint As TableCheckConstraint
Dim entNames As V ariant
Dim entCount As V ariantc语言指针流程图
Dim entLoop As Integer
'Start MS Word and make it visible.
Set Word = CreateObject("Word.Application")
Wait 1 'Wait 1 second to allow application to be instantiated
Word.V isible = True
Word.Documents.Add
Set ActiveDoc = Word.Documents(1)
ActiveDoc.Activate
With ActiveDoc
.ShowSpellingErrors = False
.ShowGrammaticalErrors = False
With .pageSetup
.LeftMargin = 0.5*72 'Points
.RightMargin = 0.5*72
.TopMargin = 0.5*72
.BottomMargin = 0.5*72
End With
End With
'Init the ER/Studio variables.
Set diag = DiagramManager.ActiveDiagram
Set mdl = diag.ActiveModel
'Process the current submodel, if one exists
Set subMdl=mdl.ActiveSubModel
subMdl.EntityNames(entNames, entCount)
'Sort the entity names
fastreport二维码控件Call dhQuickSort(entNames)
'Iterate through all entities in the current sub-model
For entLoop = 0 To entCount - 1 'For Each ent In subMdl.Entities() Set ent = mdl.Entities.Item(entNames(entLoop))
With Word.Selection
'First the entity name
.Font.Bold = True
.Font.Underline = True
.Font.Size = 18
.TypeText Text:=ent.TableName
'Keep the paragraph together, and with the next paragraph
.Paragraphs(1).KeepTogether = True
.Paragraphs(1).KeepWithNext = True
'Now the entity definition
.Font.Underline = False
.Font.Bold = False
.Font.Size = 12
.TypeText Text:=" " & ent.Definition & vbCrLfbasketball的发音
'Is there a check constraint?
Set tableConstraints = ent.TableCheckConstraints
For Each tableConstraint In tableConstraints
.TypeText Text:="Constraint " _
& tableConstraint.ConstraintName _
& ": " & tableConstraint.ConstraintText & vbCrLf
Next
End With
'Iterate through all the attributes in the current entity
For Each attr In ent.Attributes
With Word.Selection
'First the attribute name
.Font.Bold = True
'Check for a rolename
If attr.AttributeName<>attr.ColumnName Then
.TypeText Text:=attr.ColumnName & "." & attr.AttributeName & ": "
Else
.TypeText Text:=attr.ColumnName & ": "
End If
.Font.Bold = False
'Then the datatype
'.TypeText Text:= attr.Datatype
.typetext Text:= attr.PhysicalDatatype
If attr.DataLength > 0 Then
.TypeText Text:= "(" & attr.DataLength & ")"
End If
.TypeText Text:= ": "
'Now the Null option and Definition
.TypeText Text:= IIf(attr.Identity, "IDENTITY", attr.NullOption) & ": " & attr.Definition & vbCrLf
'Is there a default value?
If Len(attr.DeclaredDefault) > 0 Then
.TypeText Text:= " Default V alue: " & attr.DeclaredDefault & vbCrLf
End If
'Is there a validation rule?
If Len(attr.CheckConstraint) > 0 Then
.TypeText Text:= " Constraint " & attr.CheckConstraintName _
& ": " & attr.CheckConstraint & vbCrLf
End If
End With
Next
With Word.Selection
.Paragraphs(1).KeepWithNext = False
.TypeText Text:= vbCrLf
End With
Next
End Sub
' **The following code is taken from the specified book. It has been modified
' **to perform a case insensitive sort.
' From "VBA Developer's Handbook"vba dateadd函数
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.
' Quicksort for simple data types.
' Indicate that a parameter is missing.
Const dhcMissing = -2
Sub dhQuickSort(varArray As V ariant, _
Optional intLeft As Integer = dhcMissing, _
Optional intRight As Integer = dhcMissing)
' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.
' Entry point for sorting the array.
' This technique uses the recursive Quicksort
next studio
' algorithm to perform its sort.
' In:
' varArray:
' A variant pointing to an array to be sorted.
' This had better actually be an array, or the
' code will fail, miserably. Y ou could add
'    a test for this:
' If Not IsArray(varArray) Then Exit Sub
' but hey, that would slow this down, and it's
' only YOU calling this procedure.
' Make sure it's an array. It's your problem.
' intLeft:
' intRight:
' Lower and upper bounds of the array to be sorted.
' If you don't supply these values (and normally, you won't) ' the code uses the LBound and UBound functions
登陆界面测试用例怎么写' to get the information. In recursive calls
' to the sort, the caller will pass this information in.
' To allow for passing integers around (instead of
' larger, slower variants), the code uses -2 to indicate
' that you've not passed a value. This means that you won't ' be able to use this mechanism to sort arrays with negative ' indexes, unless you modify this code.
' Out:
' The data in varArray will be sorted.
Dim i As Integer
Dim j As Integer
Dim varTestV al As V ariant
Dim intMid As Integer
If intLeft = dhcMissing Then intLeft = LBound(varArray)
If intRight = dhcMissing Then intRight = UBound(varArray)
If intLeft < intRight Then
intMid = (intLeft + intRight) \ 2
varTestV al = UCase(varArray(intMid))
i = intLeft
j = intRight
Do
Do While UCase(varArray(i)) < varTestV al
i = i + 1
Loop
Do While UCase(varArray(j)) > varTestV al
j = j - 1
Loop
If i <= j Then
SwapElements varArray, i, j
i = i + 1
j = j - 1
End If
Loop Until i > j
' To optimize the sort, always sort the
' smallest segment first.
If j <= intMid Then
Call dhQuickSort(varArray, intLeft, j)
Call dhQuickSort(varArray, i, intRight)
Else
Call dhQuickSort(varArray, i, intRight)
Call dhQuickSort(varArray, intLeft, j)
End If
End If
End Sub
Private Sub SwapElements(varItems As V ariant, intItem1 As Integer, intItem2 As Integer) Dim varTemp As V ariant
varTemp = varItems(intItem2)
varItems(intItem2) = varItems(intItem1)

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。