I have a chart which I have made in Excel. Copied it manually to PowerPoint. Then I have ungrouped it twice. Then I have selected the axis shapes on the left (numbers, axis alone) and made a group. Then i have taken the rectangles of the Chart representing data, and grouped them as 1) one group for positive values and 2) one group for negative values. So I have 3 group of shapes now. I thought I could loop these three groups, but in GroupItems there are all the groups mixed together with other shapes. I came with the idea, that I could simply detect Sh.ParentGroup.Id to find out how many parents is present and to separate them on three groups by the ParentGroup.Id... So first thing I did is a simple loop trying to access Sh.ParentGroup.Id. However if I add a watch, it crashes on 4th iteration and the Visual Basic and PowerPoint, where I run the code, restarted.
For Each Sh In ActiveWindow.Selection.ShapeRange.GroupItems
' GroupParentsIDs(Sh.ParentGroup.Id) = Sh.ParentGroup.Id
MsgBox ""
Next Sh
Do you have idea why it crashes? Should I detect if the ParentGroup member exists? If it is needed to check it, then how?
Any other tips how to make it possible to differentiate between the three groups of shapes?
The key is to test the type of shape. ParentGroup will fail if it isn't a group. Something like this:
Dim sh As Shape
Dim SubSh As Shape
For Each sh In ActivePresentation.Slides(1).Shapes
Debug.Print sh.Id
If sh.Type = msoGroup Then
For Each SubSh In sh.GroupItems
Debug.Print " " & SubSh.Id
Next SubSh
End If
Next sh
Related
My question is generic because I've run into this multiple times for other aspects of an object.
I have a group of blocks that each contain a date (think of a calendar). I am using macros to revise the date based on the current date. However I need to have those blocks grouped so I can animate the collection together.
I believe I have a long workaround, but it involves code to ungroup, make the change, regroup, reconfigure animation, reassign the trigger, etc.
It seems the simple solution would be to directly modify the text of the grouped object if possible.
Grouped shapes can be accessed via the parent shape's GroupItems property.
Eg for a slide containing a single group consisting of several rectangles:
Sub Tester()
Dim s As Shape, e As Shape
With ActivePresentation.Slides(1)
For Each s In .Shapes
Debug.Print "--- " & s.Name & " ---"
'loop group items...
For Each e In s.GroupItems
Debug.Print e.Name
e.TextFrame.TextRange.Text = "OK"
Next e
'address a specific sub-shape
With s.GroupItems("Rectangle 4").TextFrame.TextRange
.Text = "Hi"
End With
Next s
End With
End Sub
I want to model something similar to a (hyper-)graph in MS Visio 2016 Professional and then export the data of the shapes to csv to further work with it.
I am trying to make a VBA Script that goes through all the shapes on the sheet and writes the (manually inserted) data from the shapes to one csv file (and in the future maybe different csv files depending on the type of the shape).
To get a feeling for VBA I tried to start with a script that counts all the shapes on the sheet but I already failed on that. Please consider this is my first time working with VBA:
Sub countShapes()
Dim shp As Shape
Dim count As Integer
count = 0
Debug.Print count
For Each shp In ActiveSheet.Shapes
count = count + 1
Debug.Print count
Next
End Sub
This returns runtime error 424, object not found.
What am I missing?
As a second step, I want the script to check that shapes that have for example the same number in the data field "id" are identical in all other data fields as well and show an error if not (before exporting to the csv files). Can I realize this using vba in visio?
Thanks a lot for any help!
ActiveSheet is an Excel property. I think you're looking for ActivePage, which is a Visio equivilent. So to fix your code above you could use this:
For Each shp In ActivePage.Shapes
count = count + 1
Debug.Print count
Next
However, if you're simply after the shape count for a page then you could write this instead:
Debug.Print ActivePage.Shapes.Count
Can I recommend some links that might also help:
http://visualsignals.typepad.co.uk/vislog/2007/10/just-for-starte.html
http://visualsignals.typepad.co.uk/vislog/2007/11/looping-through.html
vba programming for visio
As an alternative approach you might also be interested in Visio's built-in reporting tool:
Create a report of shape data (support docs)
Getting Started with Visio 16 - Build and Apply Reports from Share Data (Video)
Re the second part of your question (check data fields) I'm assuming you're talking about reading Shape Data. If that's the case you first want to check if a row named "ID" exists and, if it does, read that value. So something like this might get you going:
Public Sub TestGetCellValues()
GetShapesCellValues ActivePage, "Prop.ID"
End Sub
Public Sub GetShapesCellValues(targetPage As Visio.Page, targetCellName As String)
Dim shp As Visio.Shape
If Not targetPage Is Nothing Then
For Each shp In targetPage.Shapes
If shp.CellExistsU(targetCellName, 0) = True Then
Debug.Print shp.NameID & "!" _
& targetCellName & " = " _
& shp.CellsU(targetCellName).ResultIU
End If
Next shp
End If
End Sub
...which might output something like this (given the associated shapes):
Sheet.2!Prop.ID = 3
Related to my question in determining how to see if a shape has overflowed a page boundary (Determining if a powerpoint text box is over the page size)
I need to move rows of a table on one page to the prior page.
Fairly straightforward to determine the rows I need to cut (I've left that part of the code out for brevity). Where I am having a problem is the method of how to paste it back into the table on the prior page (table has same column dimensions).
In the UI, it is as simple as placing the cursor in the first cell of the target row and hitting paste. This completely replicates the column structure of the cut row. In VB, best I can do is paste the entire text of the cut row (all columns) gets into the one cell. I cant seem to get VB code that can replicate what is happening in the UI. What command am I missing?
For y = 2 To c
Set oSh = ActivePresentation.Slides(k + 1).Shapes("ProgTable")
With oSh.Table
.Rows(y).Select
End With
Windows(1).Selection.Cut
Set oSh = ActivePresentation.Slides(k).Shapes("ProgTable")
With oSh.Table
.Rows.Add (-1)
.Cell(oSh.Table.Rows.Count,1)textFrame.TextRange.Paste 'pastes all columns into the one cell
End With
Next y
Alternate line of code to paste clipboard that I can't get to work
.Rows(oSh.Table.Rows.Count).Cells.Item.Shape.TextFrame.TextRange.PasteSpecial (PpPasteDataType.ppPasteHTML)
'does not work, gives compile error on ITEM argument not optional
You're pasting in to a TextRange, not the table/row itself. There are some funky things in PPT's object model for sure, and some actions which seem like they should be intuitive (copy/paste) often are not. In these cases, the Application.CommandBars.ExecuteMSO method is usually where I start (also very useful if you're copying from/between different applications like Excel>PowerPoint, Word>PowerPoint, etc.)
I did this to test, and it is working as expected, so it should set you on the right track:
Sub CopyRowToAnotherTable()
Dim tbl1 As Table
Dim tbl2 As Table
Dim sld1 As Slide
Dim sld2 As Slide
Dim pres As Presentation
Dim shp As Shape
Set pres = ActivePresentation
Set sld1 = pres.Slides(1)
Set sld2 = pres.Slides(2)
Set tbl1 = sld1.Shapes(1).Table
Set tbl2 = sld2.Shapes(1).Table
'Cut the last row from tbl2:
sld2.Select '## Powerpoint requires the slide to be active/view in order to select shapes on the slide
With tbl2
.Rows(.Rows.Count).Select
pres.Windows(1).Selection.Cut
End With
'Insert in tbl1
With tbl1
.Rows.Add -1
sld1.Select
.Rows(.Rows.Count).Select
pres.Application.CommandBars.ExecuteMso "Paste"
End With
End Sub
So in your code, I think this should work:
With oSh.Table
'## select the slide:
.Parent.Parent.Select
.Rows.Add (-1)
.Rows(.Rows.Count).Select
Application.CommandBars.ExecuteMso "Paste"
End With
The tricky part about the ExecuteMso method is mainly that it's not well-documented, or it is, but it's hard to find the dox, so here is reference from a previous answer:
Documentation on the ExecuteMso method:
http://msdn.microsoft.com/en-us/library/office/ff862419.aspx
Downloadable document containing the idMSO parameters for each Office
Application:
http://www.microsoft.com/en-us/download/details.aspx?displaylang=en&id=6627
I noticed my worksheet was slowing right down, and found a few objects had been created for some reason. I ran the following macro to remove them all:
Dim Shp as Shape
For Each Shp In Worksheets("Sheet1").Shapes
Shp.Delete
Next Shp
However I keep getting The index into the specified collection is out of bounds error. So I did the following to see how many objects had been created:
Dim i As Long
i = ActiveSheet.Shapes.Count
MsgBox CLng(i)
And received the number 41152. I have tried Go To Special and selected objects, but if this number is correct my computer is crashing trying to select over 41K objects at once.
Any suggestions how to remove them all?
You can step backward through the Shapes collection to delete them from the last value in the collection Index to the first.
Like this:
i = Worksheets("Sheet1").Shapes.Count
For x = i To 1 Step -1: Worksheets("Sheet1").Shapes(x).Delete: Next
I want to count different types of shapes in my diagram, and I can't seem to get that done. I think I have to code something for that.
I use Visio 2007 for that.
I have a flow chart with mostly process shapes that I want to distinguish by name. E.g "Type A", "Type B". And at the end, I want to have a list that tells me how often I used Type A and Type B. Counting by hand will be to error prone.
I already checked out the report/statistic function (I'm using it in German, so I'm afraid I can't tell you the exact menu name), where you can define a report function by yourself, although that one misses features for my needs. I managed to make a report for my shapes, but only when they all are selected. But when the user has to select them by hand, then he can count them as well right from the start... And you have to make 4-5 clicks in order to get that static report result.
Another almost useful function I found was the layer method: Create a layer for the types I want to count, and then assign the shapes to that layer. But, again, this is too error prone. If the user misses a shape, the count will be wrong.
So I think I will need to code something with the VBA.
Additionally, I'd like to have a text field next to my diagram where the resulting counts for all types are always displayed. So that you see when you add a shape of Type A that the count goes up by one.
Could anyone help me on this?
try:
Option Explicit
Dim myShape As Shape
Sub ShapesDetails()
Call DeleteShapes(True)
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 139.5, 81.75, 72, 72).Select
Selection.Name = "Rectangle"
ActiveSheet.Shapes.AddShape(msoShapeSmileyFace, 252.75, 71.25, 72, 72).Select
Selection.Name = "Smiley Face"
Application.CutCopyMode = False
Call ShapeDetails(True)
End Sub
Sub ShapeDetails(x As Boolean)
For Each myShape In ActiveSheet.Shapes
MsgBox "Shape name: " & myShape.Name & vbTab & " Shape type: " & myShape.Type
Next
End Sub
Sub DeleteShapes(x As Boolean)
For Each myShape In ActiveSheet.Shapes
myShape.Delete
Next
End Sub
Use Data= reports = advanced to configure a report to count objects with your custom shape Property (e.g. 'MIO') && exists. (Or another field, many to choose from). I set all the boxes i wanted to count to have property 'MIO'=TRUE, and then chose to display property Displayed Text. It takes some fiddling around in the Subtotals dialog and options in the next window to get the count looking nice. Leave COUNT unticked, and in the options dialog enable 'show all values' and tick 'exclude duplicate rows from group'.
Outputs as XML Excel Viso object. I know for the visio object, to update report, right click on it =Run report.
HTH