Jump to content

Powerpoint grouping


Recommended Posts

I'm trying to figure out how to adapt this code to work with my autoit script. (it works in the vb editor for ppt)

https://support.microsoft.com/en-us/kb/163566

Sub GroupObjects()

      ' Dimension the variables.
      Dim shapeObject As shape
      Dim lSlideNumber As Long
      Dim strPrompt, strTitle As String
      Dim ShapeList() As String
      Dim count As Long

      ' Initialize the counter.
      count = 0

      ' Make sure PowerPoint is in slide view.
      If ActiveWindow.ViewType <> ppViewSlide Then

         ' Set up the error message.
         strPrompt = "You must be in slide view to run this macro." _
            & " Change to slide view and run the macro again."
         strTitle = "Not In Slide View"

         ' Display the error message.
         MsgBox strPrompt, vbExclamation, strTitle

         ' Stop the macro.
         End

      End If

      ' Get the current slide number.
      lSlideNumber = ActiveWindow.Selection.SlideRange.SlideNumber

      ' Loop through the shapes on the slide.
      For Each shapeObject In _
         ActivePresentation.Slides(lSlideNumber).Shapes

         ' See whether shape is a placeholder.
         If shapeObject.Type <> msoPlaceholder Then

            ' Increment count if the shape is not a placeholder.
            count = count + 1

            ' Get the name of the shape and store it in the ShapeList
            ' array.
            ReDim Preserve ShapeList(1 To count)
            ShapeList(count) = shapeObject.Name

         End If

      Next shapeObject

      ' If more than 1 object (excluding a placeholder object) is found,
      ' group the objects.
      If count > 1 Then
         With ActivePresentation.Slides(lSlideNumber).Shapes

            ' Group the shapes together.
            .Range(ShapeList()).Group.Select
         End With
      Else

         Select Case count

            ' One shape found.
            Case 1

               ' Set up the message.
               strPrompt = "Only one shape found." _
                  & " You need at least two shapes to group."
               strTitle = "One Shape Available"

            ' Zero shapes found.
            Case 0

               ' Set up the message.
               strPrompt = "No shapes found. You need to have at " _
                  & "least two shapes, excluding placeholders."
               strTitle = "No Shapes Available"

            ' An error occurred.
            Case Else

               ' Set up the message.
               strPrompt = "The macro found an error it could not correct."
               strTitle = "Error"

         End Select

         ' Display the message.
         MsgBox strPrompt, vbExclamation, strTitle

      End If

   End Sub

What this code does is automatically group all the objects on a slide. I am trying to adapt it to group only the objects with a specific name:

#include <Array.au3>
    Global $oPPT2 = ObjCreate("PowerPoint.Application")
    $oCopyPresentation = $oPPT2.Presentations.Open("C:\Sources\DELETEME.pptx",True)
    $oCopyPresentation.Slides(2).Select  ; move to slide 2
    $oCopySlide=$oCopyPresentation.Slides.Item(2) ; Define slide 2
    local $shapeList[0]
    for $x=1 to 80
        $ObjNames=$oCopySlide.Shapes.Item($x).Name
        MsgBox(0,"",$ObjNames)
    next
    If Stringinstr($ObjNames,"CopyObj") then _ArrayAdd($shapeList,$oCopySlide.Shapes.Item($x).Name)
    $oCopySlide.Shapes.Range($shapeList).Group.Select

This seems to work up until it gets to the group command and I cannot figure out what I need to change to get it to group all the objects. I've tried finding examples that use the index to no avail. What am I missing?

Ultimately what I want to do is group the object, then copy the group and paste it to another PPT (hence the $oppt2 obj). Can anyone point me in the right direction?

 

Edit: I have also tried this code in the PPT vb editor and it does exactly what I want (I used the name array to generate the list and pasted it into the PPT vb)

ActivePresentation.Slides(2).Shapes.Range(Array("CopyObj1", "CopyObj2", "CopyObj3", "CopyObj4", "CopyObj5", "CopyObj6", "CopyObj7", "CopyObj8", "CopyObj9", "CopyObj10", "CopyObj11", "CopyObj12", "CopyObj13", "CopyObj14", "CopyObj15", "CopyObj16", "CopyObj17", "CopyObj18", "CopyObj19", "CopyObj20", "CopyObj21", "CopyObj22", "CopyObj23", "CopyObj24", "CopyObj25", "CopyObj26", "CopyObj27", "CopyObj28", "CopyObj29", "CopyObj30", "CopyObj31", "CopyObj32", "CopyObj33", "CopyObj34", "CopyObj35", "CopyObj36", "CopyObj37", "CopyObj38", "CopyObj39", "CopyObj40", "CopyObj41", "CopyObj42", "CopyObj43", "CopyObj44", "CopyObj45", "CopyObj46", "CopyObj47", "CopyObj48", "CopyObj49", "CopyObj50", "CopyObj51", "CopyObj52", "CopyObj53", "CopyObj54", "CopyObj55")).Group.Select

 

Edited by Jewtus
Link to comment
Share on other sites

Add a COM error handler and you will get detailed error information. Please see ObjEvent in the the help file for an example.

My UDFs and Tutorials:

Spoiler

UDFs:
Active Directory (NEW 2022-02-19 - Version 1.6.1.0) - Download - General Help & Support - Example Scripts - Wiki
ExcelChart (2017-07-21 - Version 0.4.0.1) - Download - General Help & Support - Example Scripts
OutlookEX (2021-11-16 - Version 1.7.0.0) - Download - General Help & Support - Example Scripts - Wiki
OutlookEX_GUI (2021-04-13 - Version 1.4.0.0) - Download
Outlook Tools (2019-07-22 - Version 0.6.0.0) - Download - General Help & Support - Wiki
PowerPoint (2021-08-31 - Version 1.5.0.0) - Download - General Help & Support - Example Scripts - Wiki
Task Scheduler (NEW 2022-07-28 - Version 1.6.0.1) - Download - General Help & Support - Wiki

Standard UDFs:
Excel - Example Scripts - Wiki
Word - Wiki

Tutorials:
ADO - Wiki
WebDriver - Wiki

 

Link to comment
Share on other sites

Well, I put the logger in and it started working... Not sure why. I tried to toggle it off and it is still working. Must have had an orphan process or something funky going on.

 

In case someone needs it in the future:

Global $oPPT2 = ObjCreate("PowerPoint.Application")
    $oCopyPresentation = $oPPT2.Presentations.Open($filename,True,False,False)
    $oCopyPresentation.Slides(2).Select
    $oCopySlide=$oCopyPresentation.Slides.Item(2)
    local $shapeList[0]
    for $x=1 to 80
        $ObjNames=$oCopySlide.Shapes.Item($x).Name
        If StringInStr($ObjNames,"CopyObj") then _ArrayAdd($shapeList,$oCopySlide.Shapes.Item($x).Name)
    Next
    $oCopySlide.Shapes.Range($shapeList).Group.Copy

 

Edited by Jewtus
Link to comment
Share on other sites

The need for a COM error handler depends on the AutoIt version you run. After AutoIt 3.3.12.0 COM errors crash a script without COM error handler.

My UDFs and Tutorials:

Spoiler

UDFs:
Active Directory (NEW 2022-02-19 - Version 1.6.1.0) - Download - General Help & Support - Example Scripts - Wiki
ExcelChart (2017-07-21 - Version 0.4.0.1) - Download - General Help & Support - Example Scripts
OutlookEX (2021-11-16 - Version 1.7.0.0) - Download - General Help & Support - Example Scripts - Wiki
OutlookEX_GUI (2021-04-13 - Version 1.4.0.0) - Download
Outlook Tools (2019-07-22 - Version 0.6.0.0) - Download - General Help & Support - Wiki
PowerPoint (2021-08-31 - Version 1.5.0.0) - Download - General Help & Support - Example Scripts - Wiki
Task Scheduler (NEW 2022-07-28 - Version 1.6.0.1) - Download - General Help & Support - Wiki

Standard UDFs:
Excel - Example Scripts - Wiki
Word - Wiki

Tutorials:
ADO - Wiki
WebDriver - Wiki

 

Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share

  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...