Help with macro to paste grouped object on to different pages in different xy

Started by Adomka, June 17, 2020, 10:54:32 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Adomka

Ive never tried coding a macro before and my coding experience is very limited so bare with me please

I have a large drawing that I want to divide up on to different pages but visio doesnt really have a viewport function. So instead I drew rectangles where I want each page to be and copy and paste the entire drawing changing the coordinates for the group on each page so it only prints where I want it to.

So the end goal would be a loop that for the number of rectangles I selected it creates a new page, pastes at coordinates based off of the rectangles xpin ypin, goes to next rectangle and repeats till finished.

So my idea was to great an array based off the selection and then use that to automate where to paste, but I cant seem to find an answer on how to do this.


Also when just trying to select all and paste on a new page I get an error that it completed but no object returned. It copies and pasted everything to a new page but I get an said error and If I run it again it fails to create a new page and pastes on the active one.

all I have so far is:

Dim curPage as Page
Dim addPage as Viso.Page
Dim vsoShape as Viso.Shape
Dim vsoSelection as Visio.Selection

Set curPage = ActiveWindow.Page
ActiveWindow.SelectAll
Set vsoSelection = ActiveWindow.Selection

set addPage = ActiveDocument.Pages.Add
set vsoShape - ActivePage.Drop(vsoSelection,0,0)

Surrogate

Quote from: Adomka on June 17, 2020, 10:54:32 PMset vsoShape - ActivePage.Drop(vsoSelection,0,0)
you sure that this line works?
Which error you get (it number, or share screenshot?
Where (line number) you get this error?

wapperdude

This code works, but the Drop line executed and created an error...hence the Resume Next.


Sub Macro1()
    Dim vSel As Visio.Selection
    Dim vShp As Visio.Shape
    Dim vPgs As Visio.Pages
    Dim vPg As Visio.Page
   
    ActiveWindow.SelectAll
   
    Set vSel = ActiveWindow.Selection
   
    Set vPgs = ActiveDocument.Pages
    Set vPg = vPgs.Add
   
    ActiveWindow.Page = ActiveDocument.Pages.ItemU("Page-2")
    On Error Resume Next
    Set vShp = ActivePage.Drop(vSel, 4.25, 5.5)

End Sub
Visio 2019 Pro

Adomka

Thanks, I spent too much time last night trying to find a way to get the shapedata from a selection of multiple shapes. Any advice on going about this? The method I use currently to do it manually is to use the add on and export selection to excel.

wapperdude

Couldn't tell if you tried the code or not?  The code does work.
Visio 2019 Pro

Adomka

Yeah It works to copy object from one page to page-2,

I just want to edit it so it copies to the number of pages equal to number of shapes selected, and at position relative to shapes selected

In my head it would go like: Select shapes, save  x y positions of each shape to array, select all,  then for each row in the array create a page and paste the selected all on page equal to that row number and at position relative to the x y position in said row.

Hopefully, that makes sense.

wapperdude

Cool.  Wasn't quite sure if that's where your follow-up question was headed.

I think that this might be possible without using an array, but rather stepping thru the selection objects.  My thought is something like this...

1) make your selection of shapes for page 2 and group them.   
2) repeat for as many pages you want to add.  Important, do this in the order that you want the pages to be.
3) deselect last group
4) now select 1st group, then <shift> + sel each of t he remaining groups in desired order of placement. 
5) now your selection consists of, e.g., 4 objects.  You can loop thru the selections, each time adding new page and dropping the selected obj on the page.

I believe this approach should work.

Visio 2019 Pro

wapperdude

The code was easy to adapt to the method outlined above:

Sub Macro1()
    Dim vSel As Visio.Selection
    Dim vShp As Visio.Shape
    Dim vPgs As Visio.Pages
    Dim vPg As Visio.Page
       
    Set vSel = ActiveWindow.Selection
    Set vPgs = ActiveDocument.Pages
   
    For i = 1 To vSel.Count
        Set vPg = vPgs.Add
        ActiveWindow.Page = vPg
        On Error Resume Next
        Set vShp = ActivePage.Drop(vSel(i), 4.25, 5.5)
    Next
End Sub
Visio 2019 Pro

Adomka

Awesome thanks so much, this is helping a bunch. I would have a way more convoluted way of doing this.