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