I have a slide that we use in my department to provide an overview of the progress regarding project document deliverables. It is shown in a graphic manner, and therefore a simple table view or similar cannot be used. Each of the document deliverables mentioned on the slide can have 3 different legends (figures), a square, triangle and arrow. These are color coded according to stakeholder responsibility of the deliverable. Right now we are changing each one of them manually during the project
What I am looking for:
Is there a VBA code that can easily be used to replace these figures according to project status?
I imagine each Project deliverable needs to be tagged with a position on the slide, and then a userform can be used to select which type of figure there should be assigned?
Anyone who can help me or point me in a direction to something that might help me is highly appreciated!
Thank you
Peter
Here's one approach in rough outline ...
Instead of individual shapes, use a square, triangle and arrow grouped. The user selects the group they want to work with then launches your dialog box where they choose the project status for that item. Your dialog box assigns a value from 1 to 3 to the status then calls SetVisibility like so:
Sub MakeItSo()
Call SetVisibility(2)
End Sub
SetVisibility first makes all of the shapes in the group invisible, then sets the appropriate shape to be visible:
Sub SetVisibility(lStatus As Long)
Dim x As Long
With ActiveWindow.Selection.ShapeRange(1)
For x = 1 To .GroupItems.Count
.GroupItems(x).Visible = False
Next
.GroupItems(lStatus).Visible = True
End With
End Sub
Related
i'am currently trying to add a small function to PowerPoint using VBA, my goal is to create a gadget that works kind of like Photoshop graphics layer.
My plan is to add a layer name Tag on each shape that is drawn by user, so later I can parse through every item by loop and preform lock/unlock, show/hide shapes based on it's tag value, such as:
Sub add_shape_with_layer_tag()
Set islide = ActivePresentation.Slides(1)
Set ishape = islide.Shapes.AddShape(msoShapeRectangle, 5, 5, 80, 60)
ishape.Tags.Add "Layer", "1"
End Sub
Sub show_hide_layer_one_shapes()
Dim active_slide As Slide
Set active_slide = ActiveWindow.View.Slide
For Each ishape In active_slide.Shapes
If ishape.Tags("Layer") = "1" Then
ishape.Visible = Not (ishape.Visible)
End If
Next ishape
End Sub
However, I couldn't found a way to achieve this, so I would like to ask whether there's a method that provides following functions?
override add shape function so I can sneak tag value in to shape every time user drawn a shape
catch add shape event (if this thing did exist) so i can add tag to the last added item
a way to set a default tag value to shape, just like setting default shape color/line width
or is there any better options that is also viable?
thanks.
20200728
To John, thanks for the advice, I did found some interesting event that might be helpful for some of my other projects, however I couldn't found events that able to trigger after custom function while shape is added.
To Steve, my plan is to add a modeless userform with list UI that manage layers, the shape tag and shape fill texture/color will be determined based on what list item that currently selected.
As to saving settings, I'll use VBComponents.CodeModule to dump existing settings in userforms to a VBA module and store as text, so in theory I should able to make this function self contained in one file.
Not totally an answer, sorry SO, but comments don't allow enough scope for this. So ...
To Steve, my plan is to add a modeless userform with list UI that manage layers, the shape tag and shape fill texture/color will be determined based on what list item that currently selected.
Ah, so you're creating your own "pseudo-layers". That wasn't clear. Thanks for the add'l info. As it happens, I have a selection manager add-in that works very similarly to what you're proposing.
To John, thanks for the advice, I did found some interesting event that might be helpful for some of my other projects, however I couldn't found events that able to trigger after custom function while shape is added.
The SelectionChange event should get you there. When it fires, you'll need to check first to see if the current selection is a shape or something else. If a shape, check to see if its .Index = current slide's .Shapes.Count and also to see if you've already tagged it. If no tag AND if it's the correct index, it'll be a newly added shape. If you're tagging ALL shapes, you may only need to check to see if the .Tag(name) is blank.
As to saving settings, I'll use VBComponents.CodeModule to dump existing settings in userforms to a VBA module and store as text, so in theory I should able to make this function self contained in one file.
Why not save any needed slide or presentation level info as further slide- or presentation-level tags? PPT can absorb quite a lot of info as tags w/o getting cranky.
I am new to VBA in PowerPoint and I am trying to develop an interactive program for my class where a text box grouped with a bubble shape floats across the screen and they have to click it if they notice it contains a certain grapheme. I want the clicked text boxes to copy to another slide so that I can assess if the children have been successful or just clicked anything they saw.
I've pieced together this code from other sites:
Sub copyobject()
With ActivePresentation
Set myshape1 = ActivePresentation.Slides(2).Shapes(group5)
myshape1.ActionSettings(ppMouseClick).Action = myshape1.Copy
.Slides(3).myshape1.Paste
End With
End Sub
It doesn't appear to be working though. Can anybody help me out?
The error message I receive is 'compile error: method or data member not found' with .myshape1 highlighted.
If anybody could give me a completed code for this or correct what I have created I would greatly appreciate it.
Many thanks
Since the name of the object is "group5", I assume it's a group. But you can't apply an Action Setting to a group, only to a single object. This works for a single shape:
Sub copyobject()
With ActivePresentation
Set myshape1 = .Slides(2).Shapes("Rectangle 1")
myshape1.ActionSettings(ppMouseClick).Action = myshape1.Copy
.Slides(3).Shapes.Paste
End With
End Sub
BTW, an excellent VBA book for what you're doing is David Markovitz's Powerful PowerPoint for Educators. His support site for the book also has lots of free code and samples.
I have a form in Access with over 500 shapes that each represent a specific record. Each shape has the control name of Box1, Box2 etc. In VBA I am trying to capture the shape name so if the user clicks the shape called Box502 for example it will go to record 502. Since it is a shape, the other methods I have used are not capturing this control name. If I can capture the name, I can remove “Box” from it and get the number to use to go to that record.
If I use a command button instead of a shape I can use the code below and get it to do what I want, but there is also code that changes the color of the shape so that does not work on the command button.
Private Sub Box2_Click()
Dim strActiveCtl As String
strActiveCtl = Replace(Me.ActiveControl.Name, "Box", "")
DoCmd.GoToRecord acDataForm, "Form1", acGoTo, [strActiveCtl]
End Sub
If I use this line of code on the shape, it is grabbing another control and not what I had clicked on.
On click I was using the code builder and this line of code, but it is capturing another control and not what I am clicking on.
Dim strActiveCtl As String
strActiveCtl = Screen.ActiveControl.Name
The reason there are these little boxes are because they basically relate to a service that is monitored. There are about 550 services monitored. When the service has been noted as reviewed the shape goes from red to green. The team wanted to be able to just click on the shape as well and have it take to them to the service it was associated with.
I can't for the life of me envision a Form with over 500 shape boxes that each represent a different record. Egads.
But maybe you have a unique reason for doing this. So I won't question this design philosophy other than to say most people use "sub-forms" and "list boxes" when trying to identify individual records like you are doing. You may be able to save yourself lots of headaches by reading up on how to design forms using those methods. (As well as many other methods that avoid putting over 500 shape boxes on your form.)
However, if this is a design that you have to adhere to... there are a few things you need to know about Access and the way it resolves the active control as well as what happens when a control is clicked on.
Whenever you click on a control or shape, if you have the control properties set so it can accept "Focus", Access instantly makes that the "active control".
So if you then go to click on something else... your shape will lose it's status of being the "active control" and the new thing will now be the new "active control".
So there is no way to click on a shape and then click on something else to launch your code that you want to have performed on the previous "active control". Access doesn't keep a memory of past "active controls".
So this brings up the question of: "What can you do to figure out if a control or shape was clicked on?"
Luckily (or unluckily) for you, when a shape is clicked on, it checks if code has been written for it's "On Click" property.
Each and every shape you put on the Form will have it's very own "On Click" property. Which means you can write a function that you can place in every single shape you create. You can pass to that function the number of which "Box" it was that called it.
This is obviously very cumbersome. (Which is why I'd suggest using "sub-forms" or "list boxes".) But it's the only way you are going to capture the Box number that is different for each of the 500 boxes since there is no way to launch other code without losing the "Focus" on which box you were on.
So if you want to continue with your "500 shapes on one Form each addressing a different record"... you could write a VBA function that calls your record with an input parameter that tells what "Box" called it. Like this:
Private Sub subGoToNewRecord(intActiveCtl As Integer)
DoCmd.GoToRecord acDataForm, "Form1", acGoTo, intActiveCtl
End Sub
Then for each Shape Box you can write:
Private Sub Box1_Click()
subGoToNewRecord 1
End Sub
Private Sub Box2_Click()
subGoToNewRecord 2
End Sub
.
.
.
Private Sub Box502_Click()
subGoToNewRecord 502
End Sub
This will get you what you want. (Although, some shapes require you to click on the outline of the shape in order make it the "active control". So you may need to make your shape boundary thick and tell users to click on the boundary line.)
Once again, I have no idea why you'd want to do this. I'd suggest again to look into what "sub-forms" are and to look into what "List Boxes" are. They are much better suited to helping you select a desired record and then make that the "Active Record".
Hope that helps. :)
I'm trying to have several slides with tables, each table has 3 columns, the last column is the "reference value" and I want it to be hidden during the presentation and show it only by pressing a button or a hyperlink, each row individually. I think it's possible because I'm really new at coding and I have managed to do it by changing the cell's text format from white (which is the table's background color) to red, but I can only do it for all the tables at once, and I need individual values on each one of them. (I hope I'm making myself clear). This is what I have done so far:
Sub format()
Dim s As Slide
Dim oSh As Shape
Dim oTbl As Table
For Each s In ActivePresentation.Slides
For Each oSh In s.Shapes
If oSh.HasTable Then
Set oTbl = oSh.Table
With oTbl.Cell(2, 3).Shape.TextFrame.TextRange
.Text = "4500-9000"
.Font.Size = 12
.Font.Color = vbRed
End With
End If
Next
Next s
End Sub
But this will change the same cell on every table I have, I want it to change specific cells in specific tables one by one, since they all have different valued. I know I could do this with animations, but I'd rather do it this way.
EDIT: It would be great if, instead of pressing a button, I could get the data by hovering the pointer over the empty cell, and have it hidden away again when I hover the cursor off the cell.
In any case, whenever I do any change to the presentation during slideshow, the change will still be there at the end, which means It would only work once and then I would have to fix and hide all the values again, is there a way to restore the changes done during the presentation when it ends?
you could adpt your sub and call it from another procedure by passing a reference to the table and cell you want to process like this:
Sub FormatTableCell(oTbl As Shape, lRow As Long, lCol As Long)
With oTbl.Cell(lRow, lCol).Shape.TextFrame.TextRange
.Text = "4500-9000"
.Font.Size = 12
.Font.Color = vbRed
End With
End Sub
For example:
With ActivePresentation
FormatTableCell .Slides(1).Shapes("MyTable"), lRow:=1, lCol:=1
End With
Regarding the triggers for hover over and hover out, this is a tricky aspect of PowerPoint. There IS a trigger to run code when hovering over a shape but there is NOT a trigger for hovering out of a shape. To achieve the latter, you could put a transparent rectangle in the back layer of your slide and use that to spoof the hover out trigger by linking a hover over macro to it. Write your code and use the Insert / Action / Mouse Over function to trigger your VBA procedure with a signature like this:
Public Sub FormatThisTable(oTbl As Shape)
Note that this method only passes the shape (a table in your case) and not the cell the mouse is hovering over. The only way I can see you could achieve that would be to use a lot of very complex Windows APIs to detect the mouse cursor position relative to the table's on-screen coordinates.
Alternative approaches could either be to ungroup the table to a set of separate shapes or create cover shapes for each cell you need to show/hide and manage their visibility properties using the mouse in/out technique above.
For the last point, you will need to use application level events which requires code in a class module and this a good article to show you how:
http://www.pptfaq.com/FAQ00004_Make_your_VBA_code_in_PowerPoint_respond_to_events.htm
Step 1
Launch PowerPoint and open the PPTX file that contains the rows you want to hide. Click the appropriate slide in the Slides pane to the left of the screen.
Step 2
Double-click the spreadsheet on the slide, which will allow you to edit it. Select the rows that you want to hide. Click the “Home” tab and locate the “Cells” section. Click the “Format” option, which will display a list of available features.
Step 3
Place the pointer over the “Hide & Unhide” listing in the “Visibility” section. Click the “Hide Rows” option to hide the selected rows. Click outside the spreadsheet to return to the PowerPoint slide.
Probably a very stupid question but I can't figure how to rename an object in PowerPoint.. For example, all my Graphs are called by default "Graph 1" etc.
Could someone help me on that?
Thanks!
In PowerPoint 2007 you can do this from the Selection pane.
To show the Selection pane, click on the Home tab in the ribbon, then click on Arrange and then 'Selection Pane...' at the bottom. The Selection pane will open on the right. (Or press CTRL+F10)
To rename an object, first select the object and then double click on the object name in the Selection pane and you will be able to type the new object name.
(This answer assumes you are merely assigning more meaningful names during development, so your other code that references the objects can be more readable).
Put the code below into a sub, then run it from the slide in question. Each shape will be selected in turn, so you can see what shape is being referenced. An input box will tell you the current name and ask you for a new name. If you cancel or OK a zero-length input, the old name will stay in place. There is no name entry validation in this code, so be sure you type only valid names. After running it once, you can run it again just to check that the names you typed in the first round were applied to the object you intended.
The loop will cover all objects on the current slide, so if you want to process multiple slides, you have to run this separately on each slide. Every object on the slide is considered: title, drawing objects, groups, embedded pictures, equations, etc. etc. - just don't type a new name for objects that you don't care.
After your development is finished, best hide (Private Sub) or erase this code, so your users don't change object names by mistake.
Dim s As Integer, NewName As String
With ActiveWindow.Selection.SlideRange
For s = 1 To .Shapes.Count
.Shapes(s).Select ' So you can see the object in question
NewName = InputBox(.Shapes(s).Name) ' Tell what current name it is and ask for new name
If Len(NewName) > 0 Then .Shapes(s).Name = NewName ' If you typed a new name, apply it
Next s ' 1 To .Shapes.Count
End With ' ActiveWindow.Selection.SlideRange
Thanks for your help but actually I am just doing it using VBA...
ActiveWindow.Selection.ShapeRange(1).Name = "newname"
Cheers