• Create BookmarkCreate Bookmark
  • Create Note or TagCreate Note or Tag
  • PrintPrint
Share this Page URL
Help

Chapter 23. Visio Automation and Microso... > Querying Word for Visio's Use

Querying Word for Visio's Use

Listing 23.3 is another example of collecting information in Visio SmartShape symbols and passing them to Word to generate a full report about the business process in the business process diagram. This code can be found in Process CH32.VSD on the companion CD.

Listing 23.3. Passing Data from Visio to Word

Private Sub btnReportToWord_Click()
    Call MakeWordReport
End Sub
Global intStepIndex As Integer
Global intDirtyFlag As Integer
Global shpObjSubjectStep As Visio.Shape
Public Sub ShowNotes()
    If Visio.ActiveWindow.Selection.Count = 1 Then
        If Visio.ActiveWindow.Selection.Item(1).CellExists("Prop.Cost", 0) = True Then
            Set shpObjSubjectStep = Visio.ActiveWindow.Selection.Item(1)
            frmNotes.Show
        End If
    End If
End Sub
Private Sub buAccept_Click()
    shpObjSubjectStep.Data1 = Me.tbNoteText.Text
    intDirtyFlag = 0
End Sub

Private Sub buCxl_Click()
    If intDirtyFlag = 1 Then
        Dim intRetVal As Integer
        intRetVal = MsgBox("Save Note Text Changes to Shape?", vbQuestion + vbYesNo, "Unsaved Changes")
        If intRetVal = vbYes Then
            shpObjSubjectStep.Data1 = Me.tbNoteText.Text
        End If
        Unload frmNotes
    Else
        Unload frmNotes
    End If
End Sub

Private Sub buNext_Click()
    Dim collObjShapes As Visio.Shapes
    Dim shpObjTempShape As Visio.Shape
    Dim intShapeCounter As Integer
    Dim intRetVal As Integer
    Dim selObj As Visio.Selection
    If intDirtyFlag = 1 Then
        intRetVal = MsgBox("Save Note Text Changes to Shape?", vbQuestion + vbYesNo, "Unsaved Changes")
        If intRetVal = vbYes Then
            shpObjSubjectStep.Data1 = Me.tbNoteText.Text
        End If
        intDirtyFlag = 0
    End If
    Set collObjShapes = Visio.ActivePage.Shapes
    For intShapeCounter = 1 To collObjShapes.Count
        Set shpObjTempShape = collObjShapes.Item(intShapeCounter)
        If shpObjTempShape.CellExists("Prop.Cost", 0) = True Then
            If Val(shpObjTempShape.Cells("Comment").Result(visNumber)) = intStepIndex + 1 Then
                Set shpObjSubjectStep = shpObjTempShape
                Set selObj = Visio.ActiveWindow.Selection
                selObj.Select shpObjSubjectStep, visSelect + visDeselectAll
                intStepIndex = intStepIndex + 1
                intShapeCounter = collObjShapes.Count
                Me.tbNoteText.Text = shpObjSubjectStep.Data1
                intDirtyFlag = 0
                Me.Caption = "Visio Dynamic Notes. Shape: " & shpObjSubjectStep.Name
                If Val(shpObjTempShape.Cells("Comment").Result(visNumber)) = 9 Then
                    MsgBox "End Of Process Steps Reached", vbExclamation + vbOKOnly, "No Further Process Steps Available"
                End If
            End If
        End If
    Next intShapeCounter
End Sub

Private Sub buOK_Click()
    shpObjSubjectStep.Data1 = Me.tbNoteText.Text
    Unload frmNotes
End Sub

Private Sub buPrev_Click()
    Dim collObjShapes As Visio.Shapes
    Dim shpObjTempShape As Visio.Shape
    Dim intShapeCounter As Integer
    Dim intRetVal As Integer
    Dim selObj As Visio.Selection
    If intDirtyFlag = 1 Then
        intRetVal = MsgBox("Save Note Text Changes to Shape?", vbQuestion + vbYesNo, "Unsaved Changes")
        If intRetVal = vbYes Then
            shpObjSubjectStep.Data1 = Me.tbNoteText.Text
        End If
        intDirtyFlag = 0
    End If
    Set collObjShapes = Visio.ActivePage.Shapes
    For intShapeCounter = 1 To collObjShapes.Count
        Set shpObjTempShape = collObjShapes.Item(intShapeCounter)
        If shpObjTempShape.CellExists("Prop.Cost", 0) = True Then
            If Val(shpObjTempShape.Cells("Comment").Result(visNumber)) = intStepIndex - 1 Then
                Set shpObjSubjectStep = shpObjTempShape
                Set selObj = Visio.ActiveWindow.Selection
                selObj.Select shpObjSubjectStep, visSelect + visDeselectAll
                intStepIndex = intStepIndex - 1
                intShapeCounter = collObjShapes.Count
                Me.tbNoteText.Text = shpObjSubjectStep.Data1
                intDirtyFlag = 0
                Me.Caption = "Visio Dynamic Notes. Shape: " & shpObjSubjectStep.Name
                If Val(shpObjTempShape.Cells("Comment").Result(visNumber)) = 1 Then
                    MsgBox "Beginning Of Process Steps Reached", vbExclamation + vbOKOnly, "No Previous Process Steps Available"
                End If
            End If
        End If
    Next intShapeCounter
End Sub

Private Sub Frame1_Click()

End Sub

Private Sub tbNoteText_Change()
    intDirtyFlag = 1
End Sub

Private Sub UserForm_Activate()
    intStepIndex = Val(shpObjSubjectStep.Cells("Comment").Result(visNumber))
    Me.tbNoteText.Text = shpObjSubjectStep.Data1
    intDirtyFlag = 0
    Me.Caption = "Visio Dynamic Notes. Shape: " & shpObjSubjectStep.Name
End Sub
Public Sub MakeWordReport()
    Dim wrdDocObj As Word.Document
    Dim intTick As Integer
    Dim intInnerTick As Integer
    Dim wrdObjsel As Word.Selection
    Dim wrdApp As Word.Application
    Dim intPathCount As Integer
    Dim strProps As String
    Dim dblResTot As Double
    Dim dblResTemp As Double
    Dim dblDurTot As Double
    Dim dblCostTot As Double
    Dim dblCPRUTot As Double


    ' create a new instance of Word
    Set wrdApp = CreateObject("Word.Application")
    wrdApp.Visible = True

    ' Add a new document to the Word application
    Set wrdDocObj = wrdApp.Documents.Add("Normal.dot")

    ' Add some title text
    Set wrdObjsel = wrdDocObj.ActiveWindow.Selection
    wrdObjsel.Style = wrdDocObj.Styles("Heading 1")
    wrdObjsel.TypeText Text:="Process Flow Diagramme"
    wrdObjsel.TypeParagraph

    wrdObjsel.Style = wrdDocObj.Styles("Heading 2")
    wrdObjsel.TypeText Text:="Business Procedures"
    wrdObjsel.TypeParagraph


    ' Select all the flowchart stuff in the drawing
    ' Start by deselecting everything
    Visio.ActiveWindow.DeselectAll

    ' Step through the shapes and look for cost property, assume flowchart shape
    For intTick = 1 To ActivePage.Shapes.Count
        With ActivePage.Shapes(intTick)
            If .CellExists("Prop.Cost", 0) = True Then
                ' Select the shape
                ActiveWindow.Select ActivePage.Shapes(intTick), visSelect
            ElseIf .CellExists("EndX", 0) = True Then
                ActiveWindow.Select ActivePage.Shapes(intTick), visSelect
            End If
        End With
    Next intTick
' Copy to Clipboard
   ActiveWindow.Copy

   ' Paste diagram into Word
   wrdObjsel.Paste
   wrdObjsel.InsertBreak wdPageBreak

   ' Print out a detailed report of each process node in Word

   wrdObjsel.Style = wrdDocObj.Styles("Heading 2")
   wrdObjsel.TypeText Text:="Business Procedures Flow Details"
   wrdObjsel.TypeParagraph

    ' Step through all the process steps and print out the notes
    dblResTot = 0
    dblDurTot = 0
    dblCostTot = 0
    dblCPRU = 0
    dblResTemp = 0
    For intTick = 1 To ActivePage.Shapes.Count
        With ActivePage.Shapes(intTick)
            ' If the cost property exists, assume process shape
            If .CellExists("Prop.Cost", 0) Then
                    ' put title of system in
                    wrdObjsel.Style = wrdDocObj.Styles("Heading 3")

                    ' Print out shape detail

                    wrdObjsel.TypeText Text:=.Text & vbCrLf
                    wrdObjsel.Style = wrdDocObj.Styles("Normal")
                    strProps = .Data1 & vbCrLf
                    dblCostTot = dblCostTot + .Cells("Prop.Cost").Result(visNumber)
                    strProps = strProps & .Cells("Prop.Cost").ResultStr("usd") & vbCrLf
                    dblDurTot = dblDurTot + .Cells("Prop.Duration").Result(visNumber)
                    strProps = strProps & .Cells("Prop.Duration").Result(visNumber) & " Person Hour(s)" & vbCrLf
                    dblResTemp = Val(.Cells("Prop.Resources").ResultStr(""))
                    If dblResTemp > dblResTot Then
                        dblResTot = dblResTemp
                    End If
                    strProps = strProps & .Cells("Prop.Resources").ResultStr("") & vbCrLf
                    dblCPRUTot = dblCPRUTot + (.Cells("Prop.Duration").Result(visNumber) * Val(.Cells("Prop.Resources").ResultStr("")))
                    wrdObjsel.TypeText strProps
            End If
        End With
    Next intTick
   wrdObjsel.Style = wrdDocObj.Styles("Heading 2")
   wrdObjsel.TypeText Text:="Business Procedures Flow Totals"
   wrdObjsel.TypeParagraph
   wrdObjsel.Style = wrdDocObj.Styles("Heading 3")
   wrdObjsel.TypeText Text:="Total Business Procedures Cost"
   wrdObjsel.TypeParagraph
   wrdObjsel.Style = wrdDocObj.Styles("Normal")
   wrdObjsel.TypeText Text:=FormatCurrency(dblCostTot, 2)
   wrdObjsel.TypeParagraph
   wrdObjsel.Style = wrdDocObj.Styles("Heading 3")
   wrdObjsel.TypeText Text:="Total Business Procedures Duration"
   wrdObjsel.TypeParagraph
   wrdObjsel.Style = wrdDocObj.Styles("Normal")
   wrdObjsel.TypeText Text:=Str(dblDurTot) & " Person Hours"
   wrdObjsel.TypeParagraph
   wrdObjsel.Style = wrdDocObj.Styles("Heading 3")
   wrdObjsel.TypeText Text:="Total Business Procedures Resources"
   wrdObjsel.TypeParagraph
   wrdObjsel.Style = wrdDocObj.Styles("Normal")
   wrdObjsel.TypeText Text:=Str(dblResTot) & " Persons"
   wrdObjsel.TypeParagraph
   wrdObjsel.Style = wrdDocObj.Styles("Heading 3")
   wrdObjsel.TypeText Text:="Calculated Cost Per Resource Unit Figure"
   wrdObjsel.TypeParagraph
   wrdObjsel.Style = wrdDocObj.Styles("Normal")
   wrdObjsel.TypeText Text:=FormatCurrency((dblCostTot / dblCPRUTot), 2)
   wrdObjsel.TypeParagraph

   Visio.ActiveWindow.DeselectAll

End Sub


					  


PREVIEW

                                                                          

Not a subscriber?

Start A Free Trial


  
  • Creative Edge
  • Create BookmarkCreate Bookmark
  • Create Note or TagCreate Note or Tag
  • PrintPrint