You can do it with VBA. I use this (code extract)
Al
' Process the pages
strCurStep = "start process other files"
Set pagsObj = srcDoc.Pages
' iterate through the collection
For curPageIndx = 1 To pagsObj.Count
' retrieve the page object at the current index
Set srcPage = pagsObj.Item(curPageIndx)
' Check whether the current page is a background
page
' Display the name of all the foreground pages
If srcPage.Background = False Then
strCurStep = "work on foreground pages"
' take spaces out of the document name
strDocName = funcReplaceStr(srcDoc.Name, " ",
"", 1)
' create the new page
Set tgtPage = tgtDoc.Pages.Add
' the target page name is the source document
and page number
tgtPage.Name = Left(funcGetTokens(strDocName,
"Guideline", 1), 23) & curPageIndx & "Exmpl"
tgtPage.BackPage = "Background General"
tgtPage.Background = False
blnResult = funcCopyPageFormat(tgtPage, srcPage)
If blnResult = False Then Debug.Print
"Result Copy Page format failed"
strCurStep = "copy the page"
Visio.Application.ScreenUpdating = False
blnResult = funcCopyPage(tgtPage, srcPage)
If blnResult = False Then Debug.Print
"Result Copy Page failed"
Visio.Application.ScreenUpdating = True
tgtWin.Activate
ActivePage.Name = tgtPage.Name
ActivePage.CenterDrawing
Else
' Process the background page
' or delete this section to ignore the background
pages
End If
Next curPageIndx
Private Function funcCopyPage(tgtPage As Visio.Page, srcPage As Visio.Page)
As Boolean
Dim iObjCnt As Integer
Dim iConCtr As Integer
Dim iWinCtr As Integer
Dim strPageName As String
Dim curWin As Visio.Window
Dim strCurStep As String
On Error GoTo CopyPage_Err
' go to the source window
strCurStep = "activate source win"
srcWin.Activate
ActivePage.Name = srcPage.Name
' brute force method of copy
strCurStep = "Copy source"
ActiveWindow.SelectAll
ActiveWindow.Group
ActiveWindow.Copy
' now go and paste it
strCurStep = "activate target win"
tgtWin.Activate
strCurStep = "set target apctive page"
ActivePage.Name = tgtPage.Name
ActivePage.Paste
funcCopyPage = True
CopyPage_Exit:
DoEvents
Exit Function
CopyPage_Err:
Debug.Print "Error CopyPage Cur Step = "; strCurStep
Debug.Print "Error CopyPage " & Err.Number & ": " & Err.Description
funcCopyPage = False
Resume CopyPage_Exit
End Function
' We want to copy page formats to target pages for a number of reasons
' which include common looks as well as maintaining integrity of copied
' pages.
Private Function funcCopyPageFormat(tgtPage As Visio.Page, srcPage As
Visio.Page) As Boolean
Dim tgtPageSheet As Visio.Shape
Dim srcPageSheet As Visio.Shape
On Error GoTo CopyPageFormat_Err
Set tgtPageSheet = tgtPage.PageSheet
Set srcPageSheet = srcPage.PageSheet
'Debug.Print "change size type"
tgtPageSheet.Cells("DrawingSizeType").FormulaU =
srcPageSheet.Cells("DrawingSizeType").FormulaU
'Debug.Print "change scale type"
tgtPageSheet.Cells("DrawingScaleType").FormulaU =
srcPageSheet.Cells("DrawingScaleType").FormulaU
'Debug.Print " drawing scale"
tgtPageSheet.Cells("DrawingScale").FormulaU =
srcPageSheet.Cells("DrawingScale").FormulaU
'Debug.Print " page scale "
tgtPageSheet.Cells("PageScale").FormulaU =
srcPageSheet.Cells("PageScale").FormulaU
'Debug.Print "width"
tgtPageSheet.Cells("PageWidth").FormulaU =
srcPageSheet.Cells("PageWidth").FormulaU
'Debug.Print "height"
tgtPageSheet.Cells("PageHeight").FormulaU =
srcPageSheet.Cells("PageHeight").FormulaU
'Debug.Print "route"
tgtPageSheet.Cells("RouteStyle").FormulaU =
srcPageSheet.Cells("RouteStyle").FormulaU
funcCopyPageFormat = True
CopyPageFormat_Exit:
DoEvents
Exit Function
CopyPageFormat_Err:
Debug.Print "Error CopyPageFormat " & Err.Number & ": " &
Err.Description
funcCopyPageFormat = False
Resume CopyPageFormat_Exit
End Function
lisak said:
I have pages that i want to re-use in another document. But it seems
impossible to import or export visio pages between visio documents??? Can
this be? help
