Can not remove the picture holder (Bitmap) in the org chart shape

[Forrestgump1]

Hi there,

I am trying to automatically generate an org chart via Visio which is generated from excel data and them format it automatically. However I am stuck trying to remove the picture holder within the org chart shapes. The code I have so far is:-


Sub DeleteAllBitmapsInContainers()
Dim shp As Visio.Shape
Dim page As Visio.Page
' Get the active page
Set page = Visio.ActivePage
' Call recursive function to delete bitmaps
DeleteBitmapsRecursive page.Shapes
MsgBox "All bitmaps have been deleted from the page, including containers.", vbInformation
End Sub


Sub DeleteBitmapsRecursive(shapes As Visio.Shapes)
Dim shp As Visio.Shape
Dim shpIndex As Integer
' Loop through all shapes in reverse order
For shpIndex = shapes.Count To 1 Step -1
Set shp = shapes(shpIndex)
' Check if the shape is a bitmap (Picture)
If shp.Type = visTypeForeignObject Then
If shp.ForeignType = visTypeBitmap Then
' Delete the shape
shp.Delete
End If
End If
' Check if the shape contains sub-shapes (e.g., container or grouped shape)
If shp.Shapes.Count > 0 Then
' Recursive call for sub-shapes
DeleteBitmapsRecursive shp.Shapes
End If
Next shpIndex
End Sub

I have tried searching for books on Visio VBA but there doesn't seem to be much on the subject. I have excel VBA experience but I can't work it out. As always any help is greatly appreciated.

Kind regards,

Forrestgump1

[Aussiebear]

Does this work for you?


Sub RemoveOrgChartPictures()
Dim vsoPage As Visio.Page
Dim vsoShape As Visio.Shape
' Loop through all pages in the document
For Each vsoPage In ThisDocument.Pages
' Loop through all shapes on the current page
For Each vsoShape In vsoPage.Shapes
' Check if the shape is an org chart shape (adjust this condition as needed)
If vsoShape.Master.Name Like "*Org Chart*" Then
' Remove the picture from the shape
vsoShape.Fill.Solid
End If
Next vsoShape
Next vsoPage
End Sub

[Aussiebear]

And just in case you wanted to remove the placeholders (Thanks to John Wilson)


Sub DeleteEmptyPlaceholders()
Dim oSlide as Slide
Dim 0Shape as Shape
Dim i as Integer
For each oSlide in ActivePresentation.Slides
For i = oSlide.Shapes.Count To 1 Step -1
Set oShape = oSlide.Shapes(i)
With oShape
If .Type = msoPlaceholder Then
If .Placeholder.ContainedType - 1 Then
' Its is either a Container/Text Placeholder or another type with no content
If .HasTextFrame Then ' Content/text
If . TextFrame.TextRange.Length = 0 Then .Delete
ElseIf .PlaceholderFormat.Type = ppPlaceholderChart Then . Delete
End If
End If
End If
End If
End With
Next i
Nexy oSlide
End Sub

[Forrestgump1]

I think the above code is for PowerPoint not Visio?

[Aussiebear]

Did you try the code in Post # 2

[Forrestgump1]

yes i tried the code in your second post.


Dim oSlide as Slide
should that not be

Dim oSlide as Pages
and For each

oSlide in ActivePresentation.Slides
should that not be

oSlide in ActiveDocument.Pages

I still cant get the code to work though.

Any help appreciated

[Aussiebear]

I repeat did you try the code in post #2? You are referring to post # 3

[Forrestgump1]

Yes I tried that as well. I get a run time error 91 at this point in the code.

If vsoShape.Master.Name Like "*Org Chart*" Then
I changed the name to the name of my shape.

Thanks for your help again.

[Forrestgump1]

that seems to be working now but now i am getting run time error 438 at this point in the code:-


vsoShape.Fill.Solid

[Aussiebear]

A runtime error 438 suggests that it doesn't support this method.



Sub RemoveOrgChartPictures()
Dim vsoPage As Visio.Page
Dim vsoShape As Visio.Shape
Dim intFillType As Integer
For Each vsoPage In ThisDocument.Pages
For Each vsoShape In vsoPage.Shapes
If vsoShape.Master.Name Like "*Org Chart*"Then
' Check if the shape has a fill format
If Not vsoShape.Fill Is Nothing Then
' Get the current fill type
intFillType = vsoShape.Fill.Type
' Check if the fill type is compatible with Solid
If intFillType = visFillSolid Or intFillType = visFillPattern Then
' Set the fill to solid
On Error Resume Next
' Ignore potential errors
vsoShape.Fill.Solid ' <---- Trying to bludgeon this with a hammer.
On Error GoTo 0
End If
End If
End If
Next vsoShape
Next vsoPage
End Sub

If this does not work, then sorry, for I am out of ideas.