Visio2000: Cross-Functional Flowchart Shapes Incorrectly Aligned When You Open Drawing

Article translations Article translations
Article ID: 289815
This article was previously published under Q289815
This article has been archived. It is offered "as is" and will no longer be updated.
Expand all | Collapse all

Symptoms

When you change the measurement units in Page Setup, or the routing style, and then save the drawing, the drawing's flowchart shapes are incorrectly aligned the next time you open the drawing.

NOTE: If Automation events are not enabled (on the Tools menu, click Options, and then click the Advanced tab), or you open the drawing in read-only mode, this problem does not occur.

Cause

This problem occurs when there is a difference between the measurement units for page width/height, and the page and drawing scales. The problem typically occurs when the page width/height settings are set to inches, and the page/drawing scales are set to millimeters.

This difference in measurement units causes Visio to view the flowchart shape values for PinX/PinY, and either User.xRight/User.xLeft or User.yTop/User.yBottom, as the same measurement units as the page scale, which is typically in millimeters. Therefore, the shapes shift towards the zero axis.

Resolution

A supported hotfix is now available from Microsoft, but it is only intended to correct the problem that this article describes. Apply it only to systems that are experiencing this specific problem.

To resolve this problem, contact Microsoft Product Support Services to obtain the hotfix. For a complete list of Microsoft Product Support Services telephone numbers and information about support costs, visit the following Microsoft Web site:
http://support.microsoft.com/contactus/?ws=support
Note In special cases, charges that are ordinarily incurred for support calls may be canceled if a Microsoft Support Professional determines that a specific update will resolve your problem. The usual support costs will apply to additional support questions and issues that do not qualify for the specific update in question.

The English version of this fix should have the following file attributes or later:
   Date      Time         Version     Size       File name
   ---------------------------------------------------------
   4/18/2001 12:17:12 PM  5.0.2920.0  2,207,504  q289815.exe
				
After the hotfix is installed, the following files will have the listed attributes or later:
   Date      Time        Version      Size       File name
   ----------------------------------------------------------
   4/16/2001 5:41:02 PM  6.1.0.1616   5,107,712  VISLIB32.DLL
   4/16/2001 4:59:02 PM  6.1.0.1616     540,672  crosfunc.vsl
				

Status

Microsoft has confirmed that this is a problem in the Microsoft products that are listed at the beginning of this article.

More information

Microsoft provides programming examples for illustration only, without warranty either expressed or implied. This includes, but is not limited to, the implied warranties of merchantability or fitness for a particular purpose. This article assumes that you are familiar with the programming language that is being demonstrated and with the tools that are used to create and to debug procedures. Microsoft support engineers can help explain the functionality of a particular procedure, but they will not modify these examples to provide added functionality or construct procedures to meet your specific requirements.
Although the hotfix prevents further occurrences of the problem, it does not correct drawings already saved in the "shifted" state.

To reset or fix some the drawing's flowchart shapes' positions and sizes, you can use the following Microsoft Visual Basic for Applications (VBA) macro. The following macro is intended to reset enough of the drawing's shapes so that only some further editing is required.

The following macro assumes that the shapes are grouped together by being associated to a layer in Visio. The following macro will not touch or adjust any shapes that are not associated to a layer. Microsoft recommends that you only apply this macro to a copy of each original drawing.

NOTE: You must install the hotfix to use the following macro.

Steps to Take Prior to Running ResetFlowChartShapes() Macro

  1. Close all instances of Visio and apply the hotfix described in the "Resolution" section of this article. Make sure that the Crosfunc.vsl and Vislib32.dll files are updated.
  2. Start Visio. On the Tools menu, click Options. On the Advanced tab, click to clear the Enable Automation Events check box, and then click OK.
  3. Open each of the cross-functional flowchart drawings that were saved in the shifted state, and press ALT+F11 to switch to the VBA Editor.
  4. On the Insert menu, click Module. In the Code window, paste the following code:
    'Global Structures for shape processing
    Dim iPageWidth As Integer
    Dim iPageHeight As Integer
    Dim iPageScale As Integer
    Dim iDrawingScale As Integer
    Dim intShapesBaseCount As Integer
    
    Dim szFlowChtOrientation As String
    
    ' Global Constants
    Const szVertFlwCht = "Vertical holder"
    Const szHorzFlwCht = "Horizontal holder"
    Const szSpanVertFlwCht = "Banda functional"
    Const szSpanHorzFlwCht = ""
    Const NOT_FLWCHT_ERR_DESC = "Not a Functional Flowchart"
    
    '=============================================================
    ' GetPageMMUnits - Routine to obtain the Page's Units
    '
    Function GetPageMMUnits(pageObj As Visio.Page) As Long
        Dim cellObj As Visio.Cell
        Set cellObj = pageObj.PageSheet.Cells("DrawingScale")
        iDrawingScale = cellObj.Units
        Set cellObj = pageObj.PageSheet.Cells("PageScale")
        iPageScale = cellObj.Units
        Set cellObj = pageObj.PageSheet.Cells("PageHeight")
        iPageHeight = cellObj.Units
        Set cellObj = pageObj.PageSheet.Cells("PageWidth")
        iPageWidth = cellObj.Units
    End Function
    
    '=============================================================
    ' AdjustFlowchartShapes() - Routine that performs fix up to
    '  flowchart shapes.
    '
    Function AdjustFlowchartShapes(shpObj As Visio.Shape) As Long
        Dim cellPinXObj As Visio.Cell
        Dim cellPinYObj As Visio.Cell
        Dim cellUsrXLeft As Visio.Cell
        Dim cellUsrXRight As Visio.Cell
        Dim cellUsrYBtm As Visio.Cell
        Dim cellUsrYTop As Visio.Cell
        Dim cellWidthObj As Visio.Cell
        Dim cellHgtObj As Visio.Cell
        Dim dwPinXVal As Double
        Dim dwPinYVal As Double
        Dim dwxLeft As Double
        Dim dwxRight As Double
        Dim dwyTop As Double
        Dim dwyBottom As Double
        Dim dwHeight As Double
        Dim dwWidth As Double
        Dim dwTmpWidth As Double
        Dim dwTmpHeight As Double
        
        Set cellPinXObj = shpObj.Cells("PinX")
        Set cellPinYObj = shpObj.Cells("PinY")
        Set cellWidthObj = shpObj.Cells("Width")
        Set cellHgtObj = shpObj.Cells("Height")
        dwPinXVal = cellPinXObj.Result(cellPinXObj.Units)
        dwPinYVal = cellPinYObj.Result(cellPinYObj.Units)
        
        'If Vertical Flowchart
        If szFlowChtOrientation = szVertFlwCht Then
            Set cellUsrXLeft = shpObj.Cells("User.xLeft")
            Set cellUsrXRight = shpObj.Cells("User.xRight")
            dwxRight = cellUsrXRight.Result(cellUsrXRight.Units)
            dwxLeft = cellUsrXLeft.Result(cellUsrXLeft.Units)
            dwWidth = cellWidthObj.Result(cellWidthObj.Units)
            dwTmpWidth = dwxRight - dwxLeft
            ' Adjust the X Axis values
            cellPinXObj.Result(iPageScale) = Application.ConvertResult(dwPinXVal, iPageHeight, iPageScale)
            cellUsrXRight.Result(iPageScale) = Application.ConvertResult(dwxRight, iPageHeight, iPageScale)
            cellUsrXLeft.Result(iPageScale) = Application.ConvertResult(dwxLeft, iPageHeight, iPageScale)
            cellWidthObj.Result(iPageScale) = Application.ConvertResult(dwWidth, iPageHeight, iPageScale)
        End If
        'If Horizontal Flowchart
        If szFlowChtOrientation = szHorzFlwCht Then
            Set cellUsrYTop = shpObj.Cells("User.yTop")
            Set cellUsrYBtm = shpObj.Cells("User.yBottom")
            dwyTop = cellUsrYTop.Result(cellUsrYTop.Units)
            dwyBottom = cellUsrYBtm.Result(cellUsrYBtm.Units)
            dwHeight = cellHgtObj.Result(cellHgtObj.Units)
            dwTmpHeight = dwyTop - dwyBottom
            cellPinYObj.Result(iPageScale) = Application.ConvertResult(dwPinYVal, iPageWidth, iPageScale)
            cellUsrYTop.Result(iPageScale) = Application.ConvertResult(dwyTop, iPageWidth, iPageScale)
            cellUsrYBtm.Result(iPageScale) = Application.ConvertResult(dwyBottom, iPageWidth, iPageScale)
            cellHgtObj.Result(iPageScale) = Application.ConvertResult(dwHeight, iPageWidth, iPageScale)
        End If
        
    End Function
    
    '===============================================================
    ' ResetFlowChartShapes() Main driver program
    '   - Calls VerifyFunctionalFlowchart to verifies the drawing
    '       is a Cross Functional Flowchart an orientation.
    '   - Builds an array of shapes in the Layer "Flowchart".
    '   - Submits each shape in array to AdjustFlowchartShapes
    '       to fix up shapes PinX or PinY positions.
    '
    '  This routine requires the drawing window to be the ActiveWindow,
    '  and also that the drawing page that needs the shapes reset be
    '  the ActivePage when the code is run.
    '  Additionally, this routine prompts for the layer
    '  the shapes are on (typically called "FlowChart") that 
    '  needs to be reset. If the shapes are on no layer, type 
    '  nothing into the input box when you are prompted.
    '
    '  This is sample code meant for demonstration purposes only.
    '  Run the code only on a copy of your drawing documents, and never
    '  on the originals.
    '
    Sub ResetFlowChartShapes()
    Dim docsObj As Visio.Documents
    Dim docObj As Visio.Document
    Dim mastsObj As Visio.Masters
    Dim mastObj As Visio.Master
    Dim pagesObj As Visio.Pages
    Dim pageObj As Visio.Page
    Dim layersObj As Visio.Layers
    Dim layerObj As Visio.Layer
    Dim shpsObj As Visio.Shapes
    Dim shpObj As Visio.Shape
    Dim shpary() As Visio.Shape
    
    Dim szObjName As String
    Dim szLayerName As String
    
    Dim rst As Long
    Dim intMastsBaseCount As Integer
    Dim intMastsCount As Integer
    Dim intPagesBaseCount As Integer
    Dim intPagesCount As Integer
    Dim intShapesCount As Integer
    Dim iShpCounter As Integer
    Dim UBnd As Integer, LBnd As Integer
    On Error GoTo Errhdl
    
    iShpCounter = 0
    Set docsObj = Visio.Documents
    intDocsCounter = docsObj.Count
    
    ' Verification
    VerifyFunctionalFlowchart
    
    Set docObj = ActiveDocument
    Set pageObj = ActivePage
    Set pagesObj = docObj.Pages
    intPagesCount = docObj.Pages.Count
        
        ' Iterate through the pages collection
        intPagesBaseCount = 1
            GetPageMMUnits pageObj
            Set shpsObj = pageObj.Shapes
            If pagesObj(intPagesBaseCount).Layers.Count > 0 Then
                Set layersObj = pagesObj(intPagesBaseCount).Layers
                ' Get the Layer name
                szLayerName = ""
                szLayerName = InputBox("Input the exact name of the Layer that contains the affected shapes:", _
                    "Input Layer Name")
                Set layerObj = layersObj.Item(intPagesBaseCount)
                
                ' Iterate through the Shapes collection
                intShapesCount = shpsObj.Count
                For intShapesBaseCount = 1 To intShapesCount
                    DoEvents
                    Set shpObj = shpsObj(intShapesBaseCount)
                    If shpObj.Type = 3 And (-1 <> shpObj.CellExists("BeginX", 0)) Then
                         If shpObj.LayerCount > 0 Then
                             If shpObj.Layer(1).Name = szLayerName Then
                                iShpCounter = iShpCounter + 1
                                ReDim Preserve shpary(iShpCounter)
                                Set shpary(iShpCounter) = shpObj
                                End If
                         ElseIf shpObj.LayerCount = 0 And szLayerName = "" Then
                              iShpCounter = iShpCounter + 1
                              ReDim Preserve shpary(iShpCounter)
                              Set shpary(iShpCounter) = shpObj
                         End If
                    End If
                    DoEvents
                Next intShapesBaseCount
            End If
        
        'Check for empty array
        If iShpCounter = 0 Then
            MsgBox "No shapes found in specified Layer Name."
            Exit Sub
        End If
        
        UBnd = UBound(shpary)
        LBnd = LBound(shpary)
        LBnd = 1
        'Fix up each shape in specified layer
        While LBnd <= UBnd
            AdjustFlowchartShapes shpary(LBnd)
            LBnd = LBnd + 1
        Wend
            
        MsgBox "ResetFlowChartShapes reset " & UBnd & " shape positions without errors." _
          & vbCrLf & vbCrLf & "Inspect drawing before saving changes."
    Exit Sub
    
    '==============
    ' Error handler
    '
    Errhdl:
       MsgBox "Error: " & Err.Number & vbLf & Err.Description, _
          vbCritical + vbOKOnly, "Error Encountered"
    
    End Sub
    
    '=============================================================
    ' VerifyFunctionalFlowchart - Verify flowchart is functional
    '  by inspecting the master shapes, and determine orientation.
    '
    Function VerifyFunctionalFlowchart()
              ' Get the names of all masters in the active
              ' document and display the names in the Immediate window.
              Dim masnames() As String
              ActiveDocument.Masters.GetNames masnames
              Dim iIsFuncFlwCht As Integer
              Dim lb As Integer, ub As Integer
              'Get the upper and lower bounds of the array
              lb = LBound(masnames)
              ub = UBound(masnames)
              iIsFuncFlwCht = 0
              
              While lb <= ub
                        If masnames(lb) = szHorzFlwCht Then
                            szFlowChtOrientation = szHorzFlwCht
                            iIsFuncFlwCht = 1
                        ElseIf masnames(lb) = szVertFlwCht Or masnames(lb) = szSpanVertFlwCht Then
                            szFlowChtOrientation = szVertFlwCht
                            iIsFuncFlwCht = 1
                        End If
                        lb = lb + 1
              Wend
              If iIsFuncFlwCht = 0 Then
                    MsgBox "This routine is to be run only against a Functional Flowchart", vbCritical _
                        + vbOKOnly, "Not a Functional Flowchart"
                    Err.Raise Number:=vbObjectError + 512 + 1, Description:=NOT_FLWCHT_ERR_DESC, _
                        Source:="VerifyFunctionalFlowchart()"
              End If
    End Function
    					
  5. Switch back to the affected drawing and make the page that contains the affected flowchart shapes active.
  6. Using the Drawing Explorer, (on the View menu, click Windows), inspect the Layers under the Foreground Pages folder, and note the name of the layer that the affected shapes are associated with, or if they are not associated with any layer. You may even want to create a layer temporarily and associate the affected shapes with that layer for this purpose.
  7. On the Tools menu, point to Macro, and then click Macros (or press ALT+F8). In the drop-down list, click the Module name that you added in the VBA Editor (typically Module(n)), and click Run.
  8. You are prompted to type the name of the layer that contains the flowchart shapes. Make sure to type the name exactly as it is spelled and capitalized. If the shapes are not associated with any layer, type nothing. Click OK.
  9. You can run the ResetFlowChartShapes macro multiple times if you have multiple layers.

    NOTE: You can undo any changes from the Edit menu. Also, the changes are not final unless you save the drawing document.

Properties

Article ID: 289815 - Last Review: November 2, 2013 - Revision: 3.0
Keywords: 
kbnosurvey kbarchive kbhotfixserver kbqfe kbbug kbfix KB289815

Contact us for more help

Contact us for more help
Connect with Answer Desk for expert help.
Get more support from smallbusiness.support.microsoft.com