Open Visio Shapes in the same Window as Design File either via Python or VBA script

Question

I hope someone can advise how I could fix a problem I've been having with Visio Design documents. There are several .vsdx hundred files that would open all their shapes in a new window each.

The issue comes with how to force Visio into opening all shapes in the same window.

The goal is to have the equivalent of "Options > Advanced > Open all shapes in the same window"

I tried two approaches with no success:

1. Python Script

    import os
    import win32com.client
    directory = "C:\\Users\\User\\Documents\\Designs"
    
    def process_visio_files(directory):
        print("Visio Started.")
        visio.Visible = False  # Run Visio in the background
        for root, dirs, files in os.walk(directory):
            if "Archiv" in root:
                continue  # Skip folders containing "Archiv"
            for file in files:            
                if file.endswith('.vsdx'):
                    print("File is {}".format(file))
                    full_path = os.path.join(root, file)
                    # Process the Visio file
                    document = visio.Documents.Open(full_path)
                    dir(document)
                    document.PropertyToPreventSeparateWindows = True # HERE IS WHERE I NEED TO DO SOME MAGIC FOR THE SHAPES TO OPEN IN THE SAME WINDOW
                    document.Save()
                    document.Close()
        visio.Quit()
    
    process_visio_files(directory)

I can't quite find a way to achieve the needed change with Python. VBA had some moderate success.

2. VBA script (this one closes some of the shapes, everyone that is not open in read-only mode):

Sub ProcessVisioFilesInFolders()
    Dim rootFolder As String
    rootFolder = "C:\Users\User\Documents\Designs\"

    ProcessFolder rootFolder
End Sub

Sub ProcessFolder(folderPath As String)
    Dim fs As Object
    Dim folder As Object
    Dim subfolder As Object
    Dim file As Object
    Dim visioApp As Object

    On Error Resume Next
    ' Try to get an existing instance of Visio
    Set visioApp = GetObject(, "Visio.Application")
    On Error GoTo 0

    If visioApp Is Nothing Then
        ' If Visio is not running, create a new instance
        Set visioApp = CreateObject("Visio.Application")
        visioApp.Visible = True ' Make Visio application visible
    End If

    ' Create FileSystemObject
    Set fs = CreateObject("Scripting.FileSystemObject")

    MsgBox "Processing folder: " & folderPath

    ' Loop through all files in the folder
    For Each file In fs.GetFolder(folderPath).Files
        If LCase(file.Name) Like "*.vsdx" Then
            MsgBox "Processing file: " & file.Path
            ' Process .vsdx files
            ProcessVisioFile visioApp, file.Path
        End If
    Next file

    ' Loop through all subfolders in the folder
    For Each subfolder In fs.GetFolder(folderPath).SubFolders
        ' Check if the subfolder name contains 'Archiv'
        If InStr(1, subfolder.Name, "Archiv", vbTextCompare) = 0 Then
            ' Recursively process subfolders
            ProcessFolder subfolder.Path
        Else
            MsgBox "Skipping 'Archiv' subfolder: " & subfolder.Path
        End If
    Next subfolder
End Sub

Sub ProcessVisioFile(visioApp As Object, filePath As String)
    Dim doc As Object
    Dim win As Object
    Dim shapeSheetWin As Object

    ' Open the Visio file
    Set doc = visioApp.Documents.Open(filePath)

    ' Ensure Visio application is visible and brought to the front
    visioApp.Visible = True

    ' Introduce a delay to allow the application to become active
    Dim startTime As Double
    startTime = Timer
    Do While Timer < startTime + 1 ' Adjust the delay as needed
        DoEvents
    Loop

    ' Loop through all windows
    For Each win In visioApp.Windows
        If win.Type = 1 Then ' visDrawing type
            ' Your processing logic here
            On Error Resume Next
            win.HideShapesheet
            On Error GoTo 0
        ElseIf win.Type = 2 Then ' visStencil type
            ' Close stencil windows
            Set shapeSheetWin = win
            shapeSheetWin.Close
        End If
    Next win

    ' Save the changes to the Visio file
    MsgBox "Saving changes to Visio file: " & filePath
    doc.Save

    ' Close the Visio file
    MsgBox "Closing Visio file: " & filePath
    doc.Close
End Sub

Could anyone share ideas on how to fix the issue with the shapes that open in separate windows?

Answer 1

In your original post at first picture i can see a lot of stencils which are opened in separated windows as Read-Only [RO]…
It is not ShapeSheet windows!!!

I have not documents with same issue and I create one with code

Option Base 1
Sub Prepare()
Dim pth(3) As String, curpath As String, i As Integer
pth(1) = "C:\My Shapes\19_inch_Rack_flexible_RU.vss"
pth(2) = "C:\My Shapes\Favorites.vssx"
pth(3) = "C:\My Shapes\GOST_R_21.1101-2013.vss"
For i = LBound(pth) To UBound(pth)
    curpath = pth(i)
    Documents.OpenEx curpath, visOpenRO ' open stencil in new window as read-only
Next
ActiveDocument.DocumentSheet.OpenSheetWindow ' add Document ShapeSheet window 
End Sub

At my side next code close all windows if type of window is not Drawing window. Please read more about VisWinTypes enumeration (Visio)!
Next code can close all non-drawing windows

    Sub Test()
    Dim va As Application, vw As Window
    Set va = Application
    For Each vw In va.Windows
        Debug.Print vw.Caption, vw.Type, vw.SubType
        If Not vw.Type = visDrawing Then vw.Close ' visDrawing = 1 Python dont know Visio internal constants
    Next
    ActiveDocument.ContainsWorkspaceEx = False ' prevent save document workspace (a lot of RO-opened stencils)
    ActiveDocument.Save
    End Sub

ActiveDocument.ContainsWorkspaceEx = False this line prevent save workspace (all RO stencils). Please check this article Document.ContainsWorkspaceEx property (Visio).

~~Right now I have not Python environment, I try find it later…~~
I try this code with Jupyter Notebook, it works at my side…

import win32com.client
app = win32com.client.Dispatch('Visio.Application')
app.Visible = True
for i in range(app.windows.count,1,-1):
    vw = app.windows(i)
    if vw.Type!=1:
        vw.close

app.ActiveDocument.ContainsWorkspaceEx = False
app.ActiveDocument.Save