Consulting

Results 1 to 10 of 10

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

  1. #1

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

    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
    Last edited by georgiboy; 01-10-2025 at 08:15 AM. Reason: Edited code tags

  2. #2
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,293
    Location
    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
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  3. #3
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,293
    Location
    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
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  4. #4
    I think the above code is for PowerPoint not Visio?

  5. #5
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,293
    Location
    Did you try the code in Post # 2
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  6. #6
    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
    Last edited by Forrestgump1; 01-11-2025 at 10:59 AM.

  7. #7
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,293
    Location
    I repeat did you try the code in post #2? You are referring to post # 3
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  8. #8
    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.

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

    vsoShape.Fill.Solid

  10. #10
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,293
    Location
    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.
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •