使用脚本合并多个Microsoft Visio绘图文件

      Microsoft Visio绘图文档和Microsoft Excel文档一样，存在多个页，在整理文档的过程中避免不了碰到海量合并不同文件的页到同一个文件的问题，由于手工合并比较繁琐且容易出错，特使用脚本操作Win32 OLE模拟手工合并的过程，下列代码只实现最基础的合并工作，通过在适当位置增加和修改代码可在合并过程中实现需要的特殊操作。

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

#encoding:gbk

require 'win32ole'

if ARGV.length != 2
	puts <<EOF
Usage:
	visiocmb input_file1 input_file2

EOF
	exit 1
end

app = WIN32OLE.new('visio.application')
app.Visible = true

doc1 = app.Documents.Add(File.absolute_path(ARGV[0]))
doc2 = app.Documents.Add(File.absolute_path(ARGV[1]))
doc3 = app.Documents.Add('')

newPage = doc3.Pages(1)
doc1.Pages.each do |page|
	sel = app.ActiveWindow.Selection
	page.Shapes.each do |s|
		sel.Select s,2
	end
	sel.Copy(0)
	newPage.NameU = page.Name
	newPage.Paste
	newPage = doc3.Pages.Add
end

doc2.Pages.each do |page|
	sel = app.ActiveWindow.Selection
	page.Shapes.each do |s|
		sel.Select s,2
	end
	sel.Copy(0)
	newPage.NameU = page.Name
	newPage.Paste
	newPage = doc3.Pages.Add
end
newPage.Delete(1)

doc1.Close
doc2.Close