Pregunta Fusionar archivos de Visio


Sé que puedo hacer esto manualmente usando copiar / pegar, pero estoy buscando una forma más simple.

¿Alguien sabe de una manera rápida y fácil de combinar documentos de Visio? Tengo varios archivos VSD de Visio, todos los cuales tienen el mismo tipo de documento interno (Diagrama de flujo - Unidades de EE. UU.). Cada uno de estos tiene entre 1 y 15 páginas. Me gustaría combinarlos todos en un solo archivo de Visio.

Estoy usando Visio for Enterprise Architects (11.4301.8221) así que si hay un procedimiento para hacerlo en esa versión, eso es lo que estoy buscando, pero una herramienta de terceros o una macro también funcionaría.


4


origen




Respuestas:


Esto no se puede hacer fácilmente, porque Visio no proporciona un buen método .Copy en el objeto de página en Visio.

Esto se puede hacer a través de VBA, pero no es tan sencillo como creo que debería ser.

Pegaré a continuación el código VBA que puede usar pasando una matriz de nombres de archivos que se copiarán en todas las páginas de cada uno de esos documentos. Sin embargo, tenga en cuenta que no copiará ningún valor de hoja de formas a nivel de página, ya que eso es demasiado complicado para mí ahora ... así que si simplemente está copiando formas, esto debería funcionar para usted (El sub de TryMergeDocs es lo que usé para probar esto, y parece que funciona bien) ...

Private Sub TryMergeDocs()
    Dim Docs() As Variant
    Docs = Array("C:\Tmp\JunkVSD\Drawing1.vsd", "C:\Tmp\JunkVSD\Drawing2.vsd", "C:\Tmp\JunkVSD\Drawing3.vsd")
    MergeDocuments Docs
End Sub

Sub MergeDocuments(FileNames() As Variant, Optional DestDoc As Visio.Document)
    ' merge into a new document if no document is provided
    On Error GoTo PROC_ERR
    If DestDoc Is Nothing Then
        Set DestDoc = Application.Documents.Add("")
    End If

    Dim CheckPage As Visio.Page
    Dim PagesToDelete As New Collection
    For Each CheckPage In DestDoc.Pages
        PagesToDelete.Add CheckPage
    Next CheckPage
    Set CheckPage = Nothing

    ' loop through the FileNames array and open each one, and copy each page into destdoc
    Dim CurrFileName As String
    Dim CurrDoc As Visio.Document
    Dim CurrPage As Visio.Page, CurrDestPage As Visio.Page
    Dim CheckNum As Long
    Dim ArrIdx As Long
    For ArrIdx = LBound(FileNames) To UBound(FileNames)
        CurrFileName = CStr(FileNames(ArrIdx))
        Set CurrDoc = Application.Documents.OpenEx(CurrFileName, visOpenRO)
        For Each CurrPage In CurrDoc.Pages
            Set CurrDestPage = DestDoc.Pages.Add()
            With CurrDestPage
                On Error Resume Next
                Set CheckPage = DestDoc.Pages(CurrPage.Name)
                If Not CheckPage Is Nothing Then
                    While Not CheckPage Is Nothing ' handle duplicate names by putting (#) after the original name
                        CheckNum = CheckNum + 1
                        Set CheckPage = Nothing
                        Set CheckPage = DestDoc.Pages(CurrPage.Name & "(" & CStr(CheckNum) & ")")
                    Wend
                    CurrDestPage.Name = CurrPage.Name & "(" & CStr(CheckNum) & ")"
                Else
                    CurrDestPage.Name = CurrPage.Name
                End If
                On Error GoTo PROC_ERR
                Set CheckPage = Nothing
                CheckNum = 0

                ' copy the page contents over
                CopyPage CurrPage, CurrDestPage

            End With
            DoEvents
        Next CurrPage
        DoEvents
        Application.AlertResponse = 7

        CurrDoc.Close
    Next ArrIdx

    For Each CheckPage In PagesToDelete
        CheckPage.Delete 0
    Next CheckPage

PROC_END:
    Application.AlertResponse = 0
    Exit Sub

PROC_ERR:
    MsgBox Err.Number & vbCr & Err.Description
    GoTo PROC_END
End Sub

Sub CopyPage(CopyPage As Visio.Page, DestPage As Visio.Page)
    Dim TheSelection As Visio.Selection
    Dim CurrShp As Visio.Shape
    DoEvents
    Visio.Application.ActiveWindow.DeselectAll

    DestPage.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageHeight).Formula = CopyPage.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageHeight).ResultIU
    DestPage.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageWidth).Formula = CopyPage.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageWidth).ResultIU

    Set TheSelection = Visio.ActiveWindow.Selection

    For Each CurrShp In CopyPage.Shapes
        TheSelection.Select CurrShp, visSelect
        DoEvents
    Next

    TheSelection.Copy visCopyPasteNoTranslate
    DestPage.Paste visCopyPasteNoTranslate

    TheSelection.DeselectAll
End Sub

5



Gracias. Voy a probar eso hoy! si funciona, volveré para votar y aceptar la respuesta tal como se prometió. - David Stratton
Necroing hasta cierto punto, pero puedes usar el Visio.ActivePage.SelectAll método en lugar de ir en bicicleta a través de ellos - David Colwell


Tuve un problema similar, pero también quería copiar el fondo de una página. Por lo tanto, agregué la siguiente línea en el procedimiento CopyPage:

DestPage.Background = CopyPage.Background

Y agregó otro ciclo sobre CurrDoc.Pages en el procedimiento MergeDocuments:

For Each CurrPage In CurrDoc.Pages
    Set CurrDestPage = DestDoc.Pages(CurrPage.Name)
    SetBackground CurrPage, CurrDestPage
Next CurrPage

El procedimiento SetBackground es muy simple:

Sub SetBackground(CopyPage As Visio.Page, DestPage As Visio.Page)
   If Not CopyPage.BackPage Is Nothing Then
       DestPage.BackPage = CopyPage.BackPage.Name
   End If
End Sub

Y esto funcionó. Quizás sb lo encuentre útil.


3



+1. Además, ¡y apuesto a que será útil! - David Stratton


Gracias a todos por compartir una solución.

Permítanme copiar / pegar la "fusión" de la solución de Jon y la adición del usuario26852 :-)

Esta es la macro completa que funcionó como un encanto para mí:

Private Sub TryMergeDocs()
    Dim Docs() As Variant
    Docs = Array("C:\Tmp\JunkVSD\Drawing1.vsd", "C:\Tmp\JunkVSD\Drawing2.vsd", "C:\Tmp\JunkVSD\Drawing3.vsd")
    MergeDocuments Docs
End Sub

Sub MergeDocuments(FileNames() As Variant, Optional DestDoc As Visio.Document)
    ' merge into a new document if no document is provided
    On Error GoTo PROC_ERR
    If DestDoc Is Nothing Then
        Set DestDoc = Application.Documents.Add("")
    End If

    Dim CheckPage As Visio.Page
    Dim PagesToDelete As New Collection
    For Each CheckPage In DestDoc.Pages
        PagesToDelete.Add CheckPage
    Next CheckPage
    Set CheckPage = Nothing

    ' loop through the FileNames array and open each one, and copy each page into destdoc
    Dim CurrFileName As String
    Dim CurrDoc As Visio.Document
    Dim CurrPage As Visio.Page, CurrDestPage As Visio.Page
    Dim CheckNum As Long
    Dim ArrIdx As Long
    For ArrIdx = LBound(FileNames) To UBound(FileNames)
        CurrFileName = CStr(FileNames(ArrIdx))
        Set CurrDoc = Application.Documents.OpenEx(CurrFileName, visOpenRO)
        For Each CurrPage In CurrDoc.Pages
            Set CurrDestPage = DestDoc.Pages.Add()
            With CurrDestPage
                On Error Resume Next
                Set CheckPage = DestDoc.Pages(CurrPage.Name)
                If Not CheckPage Is Nothing Then
                    While Not CheckPage Is Nothing ' handle duplicate names by putting (#) after the original name
                        CheckNum = CheckNum + 1
                        Set CheckPage = Nothing
                        Set CheckPage = DestDoc.Pages(CurrPage.Name & "(" & CStr(CheckNum) & ")")
                    Wend
                    CurrDestPage.Name = CurrPage.Name & "(" & CStr(CheckNum) & ")"
                Else
                    CurrDestPage.Name = CurrPage.Name
                End If
                On Error GoTo PROC_ERR
                Set CheckPage = Nothing
                CheckNum = 0

                ' copy the page contents over
                CopyPage CurrPage, CurrDestPage
                SetBackground CurrPage, CurrDestPage

            End With

            DoEvents
        Next CurrPage
        DoEvents
        Application.AlertResponse = 7

        CurrDoc.Close
    Next ArrIdx

    For Each CheckPage In PagesToDelete
        CheckPage.Delete 0
    Next CheckPage

PROC_END:
    Application.AlertResponse = 0
    Exit Sub

PROC_ERR:
    MsgBox Err.Number & vbCr & Err.Description
    GoTo PROC_END
End Sub

Sub CopyPage(CopyPage As Visio.Page, DestPage As Visio.Page)
    Dim TheSelection As Visio.Selection
    Dim CurrShp As Visio.Shape
    DoEvents
    Visio.Application.ActiveWindow.DeselectAll

    DestPage.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageHeight).Formula = CopyPage.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageHeight).ResultIU
    DestPage.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageWidth).Formula = CopyPage.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageWidth).ResultIU
    DestPage.Background = CopyPage.Background


    Set TheSelection = Visio.ActiveWindow.Selection

    For Each CurrShp In CopyPage.Shapes
        TheSelection.Select CurrShp, visSelect
        DoEvents
    Next

    TheSelection.Copy visCopyPasteNoTranslate
    DestPage.Paste visCopyPasteNoTranslate

    TheSelection.DeselectAll
End Sub

Sub SetBackground(CopyPage As Visio.Page, DestPage As Visio.Page)
   If Not CopyPage.BackPage Is Nothing Then
       DestPage.BackPage = CopyPage.BackPage.Name
   End If
End Sub

Sin embargo, una cosa: tuve que volver a verificar el "bloqueo" de una capa que tenía en mis páginas. Supongo que las "propiedades de capa" no se propagan por la Macro. Para mí, eso no era un gran problema para volver a bloquear todas mis capas de fondo. Pero para otra persona valdría la pena mirar un poco más allá sobre cómo copiar / pegar también las propiedades de la capa.


2





Me encontré con este problema y superé el problema utilizando la función Insertar objeto.

  • Seleccione 'Insertar' desde la barra de herramientas
  • Seleccione 'Objeto' en el menú desplegable
  • Seleccione 'Crear desde archivo'
  • Seleccione 'Dibujo de Microsoft Office Visio'
  • Seleccione 'Enlace al archivo'
  • Haga clic en 'Examinar'
  • Seleccione el archivo que desea insertar
  • Haga clic en 'Abrir'
  • Haga clic en Aceptar'

El archivo VSD se insertará como una imagen, que se puede actualizar abriendo el archivo original, o haciendo doble clic y abriendo Visio para el 'Objeto'.


1





Descargue Visio Super Utilities desde:
http://www.sandrila.co.uk/visio-utilities/ 

La instalación recibe el archivo install_readme.txt en el paquete descargado. Por favor refiérase a la instalación. Después de instalar Visio Super Utilities, use los siguientes pasos para combinar los documentos de Visio

  1. Abra los 2 documentos de Visio que desea combinar.
  2. Vaya a Complementos -> SuperUtils -> Documento -> Copiar documento a otro documento

Repita esto para cada documento fuente.


1





Gracias por el guión extremadamente útil. Agregué algunas líneas para hacer que la secuencia de comandos sea más compatible con el complemento de ingeniería de procesos. (Esto se activa si está dibujando tuberías y válvulas y cosas así con visio) Para desactivar la numeración automática o el etiquetado al ejecutar el script vba, agregue las siguientes líneas al principio:

' Disable PE automatic editing while copying
Dim prevPEUserOptions As Integer
Dim PEEnabled As Integer
If  DestDoc.DocumentSheet.CellExists("User.PEUserOptions", 1) Then
    PEEnabled = 1
    prevPEUserOptions = DestDoc.DocumentSheet.Cells("User.PEUserOptions")
    DestDoc.DocumentSheet.Cells("User.PEUserOptions") = 0
End If

y estos al final:

If (PEEnabled) Then
    DestDoc.DocumentSheet.Cells("User.PEUserOptions") = prevPEUserOptions
End If

Creo que solo lo necesitará si está ejecutando el script con un documento ya existente como objetivo. Quizás alguien más encuentre esto útil.


0