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)
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?
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
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.
Couldn't tell if you tried the code or not? The code does work.
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.
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.
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
Awesome thanks so much, this is helping a bunch. I would have a way more convoluted way of doing this.