求助VBA 合并同目录的Visio文件

票留记

烦烦，做visio方案时候，老是出错图，自己思考了一下，如果能将所有Visio图例整合在一份图纸，就能减少输入的错误，提高效率。

需求：根目录有几个图纸图例模板，其中需要合并是图纸1、图纸2和图纸3，他们的面板设置如下图所：



1）页面设置A4-横行-比例1：50





2）页面设置A4-横行-比例1：100




现在需要将图纸1、图纸2和图纸3，并命名图图纸1图纸2图纸3.vsd

麻烦各位大神忙不。谢谢 Desktop.zip (41.09 KB, 下载次数: 0)

2019-11-29 16:57 上传

点击文件名下载附件

附上原有代码：

Sub aa()


Dim app, docsrc1, docsrc2, docdest, page, shape, newPage, sel, file1, file2

file1 = InputBox("First vsd file full path.")
file2 = InputBox("Second vsd file full path.")

Set app = CreateObject("Visio.Application")
app.Visible = True

Set docsrc1 = app.Documents.Add(file1)
Set docsrc2 = app.Documents.Add(file2)
Set docdesct = app.Documents.Add("")

Set newPage = docdesct.Pages(1)

For Each page In docsrc1.Pages
    Set sel = app.ActiveWindow.Selection
    For Each shape In page.Shapes
        sel.Select shape, 2
    Next
    sel.Copy 0
    newPage.NameU = page.Name
    newPage.Paste
    Set newPage = docdesct.Pages.Add
Next

For Each page In docsrc2.Pages
    Set sel = app.ActiveWindow.Selection
    For Each shape In page.Shapes
        sel.Select shape, 2
    Next
    sel.Copy 0
    newPage.NameU = page.Name
    newPage.Paste
    Set newPage = docdesct.Pages.Add
Next

newPage.Delete (1)

docsrc1.Close
docsrc2.Close


End Sub

票留记

求助求助求助求助