Results 1 to 11 of 11
  1. #1
    Plutonium Lounger
    Join Date
    Nov 2001
    Posts
    10,550
    Thanks
    0
    Thanked 7 Times in 7 Posts

    Change fill attributes of part of a group (PPT 2000 SR1a)

    I have a fairly complex slide with a large number of different builds (50 or 60 of them).
    Each of the objects being built is a group, comprising a text box and a number of graphics.
    I need to change the fill colour of the text boxes in all the objects. If I change the fill for the group then it destroys all the graphics.

    The only method I have found is to go to each object in turn and
    Write down its current build type and order
    Ungroup it
    Change the fill
    Regroup
    Manually set the original build type and order.

    This is a major chore!

    Is there any way to preserve the build behaviour through the ungroup and regroup? Or any way to change the fill of an object in a group without having to ungroup it first?

    StuartR

  2. #2
    Silver Lounger
    Join Date
    Mar 2001
    Location
    Springfield, Ohio, USA
    Posts
    2,136
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Change fill attributes of part of a group (PPT 2000 SR1a)

    I have made a macro to do something like this and can modify it. Is a macro solution acceptable? Are you sure that the only shape that you want to change is a textbox and not any of the autoshapes? Do you want to select a group and then run the macro on just this group or do you want to change every text box in the entire presentation? --Sam
    <font face="Comic Sans MS">Sam Barrett, CACI </font face=comic>
    <small>And the things that you have heard... commit these to faithful men who will be able to teach others also. 2 Timothy 2:2</small>

  3. #3
    Plutonium Lounger
    Join Date
    Nov 2001
    Posts
    10,550
    Thanks
    0
    Thanked 7 Times in 7 Posts

    Re: Change fill attributes of part of a group (PPT 2000 SR1a)

    Thanks for the response, a macro solution would help, I'm happy to modify it as I go along.

    On this particular occassion I need to change the fill property of all textboxes on two or three slides, so it's quite easy. On another occassion I needed to change the fill colour of part of an imported graphic - I suspect a macro would have to be really clever to do this.

    I guess the Macro I want would identify every object and group on the slide and remember its build information. I could then ungroup, make changes and regroup as I need to and then rerun the macro to reapply the builds.

    StuartR

  4. #4
    Silver Lounger
    Join Date
    Mar 2001
    Location
    Springfield, Ohio, USA
    Posts
    2,136
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Change fill attributes of part of a group (PPT 2000 SR1a)

    So, all that you really want is a macro to ungroup all levels of grouping in a selected object, a macro to select all of these ungrouped shapes of a specific type, and a final macro to reestablish the grouping as it was originally?
    <font face="Comic Sans MS">Sam Barrett, CACI </font face=comic>
    <small>And the things that you have heard... commit these to faithful men who will be able to teach others also. 2 Timothy 2:2</small>

  5. #5
    Plutonium Lounger
    Join Date
    Nov 2001
    Posts
    10,550
    Thanks
    0
    Thanked 7 Times in 7 Posts

    Re: Change fill attributes of part of a group (PPT 2000 SR1a)

    Sammy,

    Ideally what the Macro needs to do is
    1. <LI>Ungroup all selected objects
      <LI>Optionally select all ungrouped shapes of a specific type from the newly ungrouped object
      <LI>Let me at the objects to make manual changes
      <LI>Reestablish the group as it was originally
      <LI>Reestablish the build properties of the group as it was originally, including the build type, order, and hide options
    I can't believe that PowerPoint makes it so difficult to change a presentation!

    StuartR

  6. #6
    Silver Lounger
    Join Date
    Mar 2001
    Location
    Springfield, Ohio, USA
    Posts
    2,136
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Change fill attributes of part of a group (PPT 2000 SR1a)

    > build type, order, and hide options

    What are these?

    This is starting to look tough and I'm still looking for the stuff I did with grouping and ungrouping. --Sam
    <font face="Comic Sans MS">Sam Barrett, CACI </font face=comic>
    <small>And the things that you have heard... commit these to faithful men who will be able to teach others also. 2 Timothy 2:2</small>

  7. #7
    Plutonium Lounger
    Join Date
    Nov 2001
    Posts
    10,550
    Thanks
    0
    Thanked 7 Times in 7 Posts

    Re: Change fill attributes of part of a group (PPT 2000 SR1a)

    Maybe I'll have a go if you can't find your stuff.

    I had been hoping that it wasn't as difficult as it sounded. Is it just me that has this problem?

    StuartR

  8. #8
    Silver Lounger
    Join Date
    Mar 2001
    Location
    Springfield, Ohio, USA
    Posts
    2,136
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Change fill attributes of part of a group (PPT 2000 SR1a)

    Wait unitl I get you started. The ungrouping is tricky.
    <font face="Comic Sans MS">Sam Barrett, CACI </font face=comic>
    <small>And the things that you have heard... commit these to faithful men who will be able to teach others also. 2 Timothy 2:2</small>

  9. #9
    Plutonium Lounger
    Join Date
    Nov 2001
    Posts
    10,550
    Thanks
    0
    Thanked 7 Times in 7 Posts

    Re: Change fill attributes of part of a group (PPT 2000 SR1a)

    Thanks, I'll wait. I've never done any PPT programming so I see an opportunity for some rapid learning!

    StuartR

  10. #10
    Silver Lounger
    Join Date
    Mar 2001
    Location
    Springfield, Ohio, USA
    Posts
    2,136
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Change fill attributes of part of a group (PPT 2000 SR1a)

    What a mess! Here's the first draft. Try to break it or see what else it needs. My test presentation is attached. HTH --Sam
    <pre>Option Explicit

    Sub ListShapeNames()
    ' Just a debugging macro that lists all of the shape names on a slide
    Dim doc As SlideRange
    Dim s As Shape
    Dim sr As ShapeRange
    Set doc = ActiveWindow.Selection.SlideRange
    Set sr = doc.Shapes.Range
    For Each s In sr
    s.Select
    MsgBox s.Name
    Next s
    End Sub

    Sub ListTags()
    ' Just a debugging macro that lists all of the tags in the selected shapes
    Dim s As Shape
    Dim i As Integer
    With ActiveWindow.Selection
    If .Type <> ppSelectionShapes Then Exit Sub
    For Each s In .ShapeRange
    For i = 1 To s.Tags.Count
    MsgBox s.Name & " is in group " & s.Tags.Item("GROUP")
    Next i
    Next s
    End With
    End Sub

    Sub UngroupSlide()
    ' This macro ungroups all of the first-level groups on a slide,
    ' saving the group animations in comment shapes

    Dim doc As SlideRange ' Current slide
    Dim s As Shape ' a shape on that slide
    Dim sr As ShapeRange ' All of the shapes on the current slide
    Dim a As AnimationSettings
    Dim ss As Shape ' New comment shape to hold animations
    Set doc = ActiveWindow.Selection.SlideRange
    Set sr = doc.Shapes.Range
    For Each s In sr
    If s.Type = msoGroup Then
    Set a = s.AnimationSettings
    Set ss = doc.Shapes.AddComment
    ss.TextFrame.TextRange.Text = s.Name & " Info"
    copyAnimations s, ss
    Dissolve s ' Ungroup & save group membership
    End If
    Next s
    End Sub

    Sub RegroupSlide()
    Dim doc As SlideRange ' Current slide
    Dim s As Shape ' a shape on that slide
    Dim sr As ShapeRange ' All of the shapes on the current slide
    Dim grpName As String ' Shape name of the group
    Dim g As Shape ' Regrouped shape
    Dim haveGroup As Boolean ' Set true if a shape has been regrouped
    Set doc = ActiveWindow.Selection.SlideRange
    Do
    haveGroup = False
    Set sr = doc.Shapes.Range
    For Each s In sr ' Find a shape that needs regrouping
    If s.Tags("GROUP") <> "" Then
    grpName = s.Tags("GROUP")
    ClearTagsFor grpName, doc ' Clear all the group's tags
    Set g = doc.Shapes.Range(s.Name).Regroup
    g.Name = grpName
    redoAnimations g, doc
    haveGroup = True
    Exit For ' Start over
    End If
    Next s
    Loop While haveGroup
    End Sub

    Sub copyAnimations(src As Shape, dest As Shape)
    ' This module copies the animations from src to dest
    With dest.AnimationSettings
    If Not src.AnimationSettings.Animate Then Exit Sub
    .AdvanceMode = src.AnimationSettings.AdvanceMode
    .AdvanceTime = src.AnimationSettings.AdvanceTime
    .AfterEffect = src.AnimationSettings.AfterEffect
    .Animate = src.AnimationSettings.Animate
    .AnimateBackground = src.AnimationSettings.AnimateBackground
    .AnimateTextInReverse = src.AnimationSettings.AnimateTextInReverse
    .AnimationOrder = src.AnimationSettings.AnimationOrder
    .DimColor = src.AnimationSettings.DimColor
    .EntryEffect = src.AnimationSettings.EntryEffect
    Select Case src.AnimationSettings.SoundEffect.Type
    Case ppSoundFile
    .SoundEffect.ImportFromFile src.AnimationSettings.SoundEffect.Name
    Case Else ' Probably won't work
    .SoundEffect.Type = src.AnimationSettings.SoundEffect.Type
    End Select
    .TextLevelEffect = src.AnimationSettings.TextLevelEffect
    .TextUnitEffect = src.AnimationSettings.TextUnitEffect
    End With
    End Sub

    Sub redoAnimations(grp As Shape, doc As SlideRange)
    ' This module searches for the comment that has the animations, copies
    ' the animations, and deletes the comment
    Dim grpName As String
    Dim s As Shape
    For Each s In doc.Shapes
    If s.Type = msoComment Then
    If s.TextFrame.TextRange.Text = grp.Name & " Info" Then
    copyAnimations s, grp
    End If
    s.Delete
    Exit Sub
    End If
    Next s
    End Sub

    Sub Dissolve(grp As Shape)
    ' This module ungroups a shape and saves the group name in a tag
    Dim grpName As String
    Dim sr As ShapeRange
    Dim s As Shape
    grpName = grp.Name
    Set sr = grp.Ungroup
    For Each s In sr
    ClearTags s
    s.Tags.Add "Group", grpName
    Next s
    End Sub

    Sub ClearTags(s As Shape)
    ' This module clears all of the tags for a given shape
    Dim i As Integer
    For i = s.Tags.Count To 1 Step -1
    s.Tags.Delete i
    Next i
    End Sub

    Sub ClearTagsFor(grp As String, doc As SlideRange)
    ' This module clears all of the tags that are part of a given group.
    Dim s As Shape
    For Each s In doc.Shapes
    If s.Tags("GROUP") = grp Then ClearTags s
    Next s
    End Sub</pre>

    Attached Files Attached Files
    <font face="Comic Sans MS">Sam Barrett, CACI </font face=comic>
    <small>And the things that you have heard... commit these to faithful men who will be able to teach others also. 2 Timothy 2:2</small>

  11. #11
    Plutonium Lounger
    Join Date
    Nov 2001
    Posts
    10,550
    Thanks
    0
    Thanked 7 Times in 7 Posts

    Re: Change fill attributes of part of a group (PPT 2000 SR1a)

    Sam,

    I'm well and truly impressed <img src=/S/clapping.gif border=0 alt=clapping width=19 height=23> This is exactly what I wanted <img src=/S/bravo.gif border=0 alt=bravo width=16 height=30>

    I have done some limited testing and it seems perfect. I'll try it out on some of my more complex slide shows over the weekend.

    StuartR

Posting Permissions

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