VBA Copy / Paste -or- Sharing between visio documents

D

Dennis

Using Visio 2003

Many are looking for a solution for which Visio does not provide; in
comparison to Excel or Word.

I know enough of VBA to be extremely dangerous - especially when it
comes to Visio which seems quite difficult to predict. Any additional
help would be extremely helpful. My intention is to make Visio easier
and more efficient for my use only. I truly do not want learn to
"program" in any language as that is not my talent nor desire. You
will see that my inability to correctly perceive just how to get the
code working (as extracted) tells the greatest truth about my VBA
(in)abilities.

My goal is to Copy a current Visio "sheet" to a new sheet (with the
same sheet-name in a New workbook) similar to what one can do in Excel.

If the code below is not that, then could someone help me get the code
below working? The break down is in the first sub-routine which is
clearly marked as an extract.

****************************************************************
From: "Al Edlund" <[email protected]>
References: <[email protected]>
Subject: Re: Visio2003 Pro - what means "Windows XP User Interface"
feature ?
Date: Mon, 23 May 2005 09:08:38 -0500

(I did attempt to email to the above lastname@....... but it bounced.)


The VBA as best as I could decifer was:

****************************************************************
Sub myCopyPaste() 'This was added by me
' 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.ScreenUpdati­ng = False
blnResult = funcCopyPage(tgtPage, srcPage)
If blnResult = False Then Debug.Print "Result Copy Page failed"
Visio.Application.ScreenUpdati­ng = 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
End Sub 'This was added by me
****************************************************

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("DrawingSiz­eType").FormulaU =
srcPageSheet.Cells("DrawingSiz­eType").FormulaU
'Debug.Print "change scale type"
tgtPageSheet.Cells("DrawingSca­leType").FormulaU =
srcPageSheet.Cells("DrawingSca­leType").FormulaU
'Debug.Print " drawing scale"
tgtPageSheet.Cells("DrawingSca­le").FormulaU =
srcPageSheet.Cells("DrawingSca­le").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
 
A

Al Edlund

I apologize for the bounce, there are people out there that don't care
enough to use good anti-virus (I was receiving over a hundred virus infected
notes a day). Yes you're correct those routines are used to copy a page (and
it's associated formatting) between documents. I used it to create a common
document from roughly twenty five other sources.
Al

Using Visio 2003

Many are looking for a solution for which Visio does not provide; in
comparison to Excel or Word.

I know enough of VBA to be extremely dangerous - especially when it
comes to Visio which seems quite difficult to predict. Any additional
help would be extremely helpful. My intention is to make Visio easier
and more efficient for my use only. I truly do not want learn to
"program" in any language as that is not my talent nor desire. You
will see that my inability to correctly perceive just how to get the
code working (as extracted) tells the greatest truth about my VBA
(in)abilities.

My goal is to Copy a current Visio "sheet" to a new sheet (with the
same sheet-name in a New workbook) similar to what one can do in Excel.

If the code below is not that, then could someone help me get the code
below working? The break down is in the first sub-routine which is
clearly marked as an extract.

****************************************************************
From: "Al Edlund" <[email protected]>
References: <[email protected]>
Subject: Re: Visio2003 Pro - what means "Windows XP User Interface"
feature ?
Date: Mon, 23 May 2005 09:08:38 -0500

(I did attempt to email to the above lastname@....... but it bounced.)


The VBA as best as I could decifer was:

****************************************************************
Sub myCopyPaste() 'This was added by me
' 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.ScreenUpdati­ng = False
blnResult = funcCopyPage(tgtPage, srcPage)
If blnResult = False Then Debug.Print "Result Copy Page failed"
Visio.Application.ScreenUpdati­ng = 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
End Sub 'This was added by me
****************************************************

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("DrawingSiz­eType").FormulaU =
srcPageSheet.Cells("DrawingSiz­eType").FormulaU
'Debug.Print "change scale type"
tgtPageSheet.Cells("DrawingSca­leType").FormulaU =
srcPageSheet.Cells("DrawingSca­leType").FormulaU
'Debug.Print " drawing scale"
tgtPageSheet.Cells("DrawingSca­le").FormulaU =
srcPageSheet.Cells("DrawingSca­le").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
 
D

Dennis

Al,

Thank you for your knowledge and time!

So far... I get one error and have another question.

funcReplaceStr(srcDoc.Name, " ", "", 1)

gets funcReplaceStr not defined ??? error.

******************************

......
Else
' Process the background page or delete this section to ignore the
background pages
End If
......

What would I consider adding to process the background page or delete this
section to ignore the background pages?

Any help with the first sub-routine would be greatly appreciated.

Dennis
 
A

Al Edlund

funcReplaceStr was a custom version of the visual basic Replace. You can use
Replace instead.
Al
 
D

Dennis

Al,

Thanks for getting back.

I did make your suggested change for funcReplaceStr

There is one more undefined Function in the code.

funcReplaceTokens

my "newsgroup-safe" working email is (e-mail address removed)

Dennis
 
D

Dennis

Al,
Found Replace Tokens - if it is relevant @:

References: <[email protected]>
Subject: Re: Instrument Tags in Process Engineering
Date: Thu, 4 Dec 2003 07:48:59 -0600

When I use it the following line it fails with a ByRef type mismatch error:
tgtPage.Name = Left(funcGetTokens(strDocName, "Guideline", 1), 23) &
curPageIndx & "Exmpl"

Feeding the line above is your suggested change for:
strDocName = funcReplaceStr(srcDoc.Name, " ", "", 1)
-which was-
strDocName = Replace(srcDoc.Name, " ", "", 1)

My guess is that Replace() may not provide what funcGetTokens wants to see.

Dennis
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Help with VBA code to Copy / Paste Visio sheet to another Visio fi 6
How do I run the following code to export visio to powerpoint? I am a newbie to macro's. 5

Top