Newbie need help with VBA Active.Window.page
Hello to all. I'm a newbie in Visio VBA. I use 2013.
I created a document with 4 pages for a Network documentation. ("Documentation.vsd"). I made 3 new pages. ("Room1", "Room2", "Room3"). I Have also a "Start" Page
In the "ThisDocument" I created for "Document_BeforeDocumentSave" a Code how reset the Color for any shapes.
Here is my Question:
When I Close the document, my Code works fine, BUT: to Change the colour I use this for each page: (Room1,2,3) in one Code. Here for exampple for Room1:
Application.ActiveWindow.Page = Application.ActiveDocument.Pages.ItemU("Room1")
Application.ActiveWindow.ViewFit = visFitPage
Dim UndoScopeID1 As Long
UndoScopeID1 = Application.BeginUndoScope("Füllfarbe")
'VT06=ID23,VT13=ID26
Application.ActiveWindow.Page.Shapes.ItemFromID(23 ).CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(238,172,72))"
Application.EndUndoScope UndoScopeID1, True
The Problem is, all the pages are just a second as active, and the changes makes a flicker, because the pages are changing for my Code from Room1 to Room2 and room 3.
Then I go back to the "Start" page.
My Question:
How can I let the Focus on the Start page and Change something (like colour) on another page, that isn't active? (Sorry for my broken english)
Thanks for all answers!
Hi Mike,
your code includes already the answer: you used the pages object of the active document in the first line.
Do something like:
Dim pg as page
for each pg in activedocument.pages
...
next page
Sub b()
Dim pn As Integer, pg As Page, sh As Shape
Application.ActiveWindow.Page = Application.ActiveDocument.Pages.ItemU("Start")
For pn = 2 To 4
Set pg = ActiveDocument.Pages(pn)
Set sh = pg.Shapes.ItemFromID(23)
sh.CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(238,172,72))"
Next
End Sub
As Yacine said, active page still Start, but this code iterate other pages and change shapes color !
Hello Yasine and Surrogate,
thanks a lot! Thats I Need, but....
I have just another Problem with that:
for example:
on page "A" i have 2 Items (ID22,23)
on page "B" I have 3 items (ID5, ID7, ID9)
on page "C" I have 4 items (ID20, .....) and so on...
On every page are different item ID's I will Change TextColor, Background or something else.
Like this:
Application.ActiveWindow.Page = Application.ActiveDocument.Pages.ItemU("A")
Application.ActiveWindow.Page.Shapes.ItemFromID(23).CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(238,172,72))"
Application.ActiveWindow.Page.Shapes.ItemFromID(23).CellsSRC(visSectionObject, visRowFill, visFillBkgnd).FormulaU = "THEMEGUARD(SHADE(FillForegnd,LUMDIFF(THEMEVAL(""FillColor""),THEMEVAL(""FillColor2""))))"
Application.ActiveWindow.Page.Shapes.ItemFromID(26).CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(238,172,72))"
Application.ActiveWindow.Page.Shapes.ItemFromID(26).CellsSRC(visSectionCharacter, 0, visCharacterColor).FormulaU = "THEMEGUARD(RGB(0,0,0))"
Application.ActiveWindow.Page = Application.ActiveDocument.Pages.ItemU("B")
Application.ActiveWindow.Page.Shapes.ItemFromID(5).CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(238,172,72))"
Application.ActiveWindow.Page.Shapes.ItemFromID(5).CellsSRC(visSectionObject, visRowFill, visFillBkgnd).FormulaU = "THEMEGUARD(SHADE(FillForegnd,LUMDIFF(THEMEVAL(""FillColor""),THEMEVAL(""FillColor2""))))"
Application.ActiveWindow.Page.Shapes.ItemFromID(7).CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(238,172,72))"
Application.ActiveWindow.Page.Shapes.ItemFromID(7).CellsSRC(visSectionCharacter, 0, visCharacterColor).FormulaU = "THEMEGUARD(RGB(0,0,0))"
and so on.
The Background:
I put this Code in the "BeforeSave" ThisDocument, to reset all Items to a Default TextColour and Background Colouer and so on.... and when the user opens the document all is on Default....
CAn you tell me, what I must do? Thanks a lot!
Greetings
Mike
Hi,
you have to iterate through the pages and find your shapes.
I would identify them by a user attribute:
Sub setDefault()
Dim pge As Visio.Page
Dim shp As Visio.Shape
For Each pge In ActiveDocument.Pages
For Each shp In pge.Shapes
If shp.CellExists("User.TypeID", False) Then
If shp.Cells("User.TypeID").ResultStr(visNone) = "myType" Then
'Do your stuff here
shp.CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(238,172,72))"
shp.CellsSRC(visSectionObject, visRowFill, visFillBkgnd).FormulaU = "THEMEGUARD(SHADE(FillForegnd,LUMDIFF(THEMEVAL(""FillColor""),THEMEVAL(""FillColor2""))))"
shp.CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(238,172,72))"
shp.CellsSRC(visSectionCharacter, 0, visCharacterColor).FormulaU = "THEMEGUARD(RGB(0,0,0))"
End If
End If
Next shp
Next pge
End Sub
(Not tested)
Hello Thomas,
thanks for your answer,
what do you mean with "User.ID"?
At this time I see in the ShapeSheet the ItemID. The Item I will "reset" with my Code is a TextBox.
Gruß
Mike
The shape ID is not a good way to identify a shape because this is only a static state of your drawing.
I guess your code is from the macro recorder.
This is OK for learning, but you have to transfer this code into a generic solution.
Proceed like this:
Open the shapesheet
* Right click
* Insert section
* User defined cells
* Add row
* rename: TypeID
* Value: "myType"
Then try my code.
Or please describe your question more detailed.
I guess your code above should work for your drawing...?
Hi Thomas, thanks for your answer,
I try it once more:
I have a networkplan for our Building with 4 Floors. For every floor I created a page(in my exaple I called it "A" or "B" and so on)
On the page "A" i have to Network Items (ID22,ID23), on the page "B" I have 3 networkitems with ID 2,3,6 for example.
When a user save the file, the "beforeSave" Code will be run. All items on every page should resetet to a Default, like I've done it with the Macro Recorder. ;)
The Problem was, that I stay on the start page, and for every page , while the macro is running, this page will come on top.
I think it's a good idea with your Code, but I have different ID's. Maybe it will works when I do it with the User.ID, like you say. I will try it. Thanks or have you just another Idea? (I#am a newbie , but i will learn..)
;D ;D ;D ;D
It WORKS!!! Great Idea, thanks a lot! I'am totally happy..... ;D :D ;) :)