Ndtyjky

This is what I have for my macro so far (details on question below):

Sub saveWithLogo()

Dim fd As FileDialog

Dim directory As String

Dim vrtSelectedItem As Variant

Dim osld As Slide

Dim oPic As Shape

Dim osldGroup As Slide

Dim oshp As Shape

Dim logoPic As Shape

Dim i As Integer

Dim num_pics As Integer

Dim fso As New FileSystemObject

Dim fileName As String

Dim filePath As String



Set fd = Application.FileDialog(msoFileDialogFilePicker)

With fd     'Get pictures from file dialog, add logo to each picture

    If .Show = -1 Then

        For Each vrtSelectedItem In .SelectedItems

            numPics = .SelectedItems.Count

            fileName = fso.GetBaseName(vrtSelectedItem)

            filePath = fso.GetParentFolderName(vrtSelectedItem)

            Set osld = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutBlank)

            Set oPic = osld.Shapes.AddPicture(vrtSelectedItem, msoFalse, msoTrue, 50, 50)

            logoWidth = 6.18 * 28.3

            logoHeight = 1.4 * 28.3

            Set logoPic = osld.Shapes.AddPicture("C:PicturesLogo" & "logo.png", lsoFalse, msoTrue, 50, 50, logoWidth, logoHeight)

        Next vrtSelectedItem

    End If

End With



For i = 1 To numPics    'Groups pictures on slide

    Set osldGroup = ActivePresentation.Slides(i)

    ActivePresentation.Slides(i).Select

    ActiveWindow.Selection.Unselect

    For Each oshp In osldGroup.Shapes

    If oshp.Type = msoPicture Then oshp.Select Replace:=False

    Next oshp

    With ActiveWindow.Selection.ShapeRange

    If .Count > 1 Then .Group

    End With



    'ActivePresentation.Slides(i).Select

    'Call ActiveWindow.Selection.SlideRange.Shapes.Export(filePath & fileName & "_with logo", ppShapeFormatJPG, 3072)



Next i



Set fd = Nothing

End Sub

From here I want to take the grouped photo from each slide and save it to the file location of the fd selected items and save each grouped photo as an amended version of the original selected item.

So if I have selected items: "photo1.jpg", "thisphoto.png" and "somedescriptivename.jpg" all from the same folder (say "C:Documentsmyprojectimages" I want it to save the new grouped photos to "C:Documentsmyprojectimages" as "photo1_with logo.jpg", "thisphoto_with logo.jpg", and "somedescriptivename_with logo.jpg".

Right now I can successfully get all the pictures onto slides and group them. I don't know how to get a unique string name for each vrtSelectedItem in .SelectedItems. I know I can change

 Dim fileName As String

to

 Dim fileName() As String

in order to save it that way but I don't know how to reference that in the for loop (fso.GetBaseName(vrtSelectedItem.Index)?). And I'm also getting the error "Compile error: Method or data member not found" when attempting to save the group.

It may solve the problem. It is not tried fully as Final Export method is throwing PowerPoint converter installation problem in my present system. But otherwise there is no error like "Compile error: Method or data member not found"

May simply try collection

Option Base 1 

'

'

' then in Declaration

Dim FileName As New Collection

Dim FilePath As New Collection

Dim FinalName As String

'

'

'the in For Each vrtSelectedItem In .SelectedItems



            FileName.Add fso.GetBaseName(vrtSelectedItem)

            FilePath.Add fso.GetParentFolderName(vrtSelectedItem)

'

'

'

' then in For i = 1 To numPics after End With



    FinalName = FilePath(i) & "" & FileName(i) & "_with logo"

    ActivePresentation.Slides(i).Select

    'MsgBox FinalName

    ActivePresentation.Slides(i).Export FinalName , ppShapeFormatJPG, 3072

Could not understand if you are placing earlier saved pictures in slides and placing logo on them? if it is that simple then may try simpler alternative with single loop

Sub saveWithLogo()

Dim fd As FileDialog

Dim directory As String

Dim vrtSelectedItem As Variant

Dim osld As Slide

Dim oPic As Shape

Dim osldGroup As Slide

Dim oshp As Shape

Dim logoPic As Shape

Dim i As Integer

Dim num_pics As Integer

Dim fso As New FileSystemObject

Dim FileName As String

Dim FilePath As String



Set fd = Application.FileDialog(msoFileDialogFilePicker)

With fd     'Get pictures from file dialog, add logo to each picture

If .Show = -1 Then

   For Each vrtSelectedItem In .SelectedItems

   numPics = .SelectedItems.Count

   FileName = fso.GetBaseName(vrtSelectedItem)

   FilePath = fso.GetParentFolderName(vrtSelectedItem)

   Set osld = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutBlank)

   Set oPic = osld.Shapes.AddPicture(vrtSelectedItem, msoFalse, msoTrue, 50, 50)

   osldno = ActivePresentation.Slides.Count

   logoWidth = 6.18 * 28.3

   logoHeight = 1.4 * 28.3

   Set logoPic = osld.Shapes.AddPicture("C:foxpro2vtoolslogo.bmp", lsoFalse, msoTrue, 50, 50, logoWidth, logoHeight)

    osld.Select

    ActiveWindow.Selection.Unselect

        For Each oshp In osld.Shapes

        If oshp.Type = msoPicture Then oshp.Select Replace:=False

        Next oshp

        With ActiveWindow.Selection.ShapeRange

        If .Count > 1 Then .Group

        End With

        FinalName = FilePath & "" & FileName & "_with logo"

        'MsgBox FinalName

   osld.Export FinalName & "_with logo", ppShapeFormatJPG ' , 3072

   Next vrtSelectedItem

   End If

End With



Set fd = Nothing

End Sub

For the curios or those with the same problem. Here's the final successful macro with what I learned from Ahmed's Answer.

I added image scaling since the output size was way smaller than the original.

Sub saveWithLogo()



Dim fd As FileDialog

Dim directory As String

Dim vrtSelectedItem As Variant

Dim osld As Slide

Dim oPic As Shape

Dim osldGroup As Slide

Dim oshp As Shape

Dim logoPic As Shape

Dim i As Integer

Dim num_pics As Integer

Dim fso As New FileSystemObject

Dim fileName As New Collection

Dim filePath As New Collection

Dim finalName As String



Set fd = Application.FileDialog(msoFileDialogFilePicker)

With fd     'Get pictures from file dialog, add logo to each picture

    If .Show = -1 Then

        For Each vrtSelectedItem In .SelectedItems

            numPics = .SelectedItems.Count

            fileName.Add fso.GetBaseName(vrtSelectedItem)

            filePath.Add fso.GetParentFolderName(vrtSelectedItem)

            Set osld = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutBlank)

            Set oPic = osld.Shapes.AddPicture(vrtSelectedItem, msoFalse, msoTrue, 50, 50)

            With oPic

                .LockAspectRatio = msoTrue

                .ScaleWidth 1.875, msoTrue

            End With

            logoWidth = 6.18 * 28.3

            logoHeight = 1.4 * 28.3

            Set logoPic = osld.Shapes.AddPicture("C:PicturesLogo Images" & "logo.png", lsoFalse, msoTrue, 100, 85, logoWidth, logoHeight)

            With logoPic

                .LockAspectRatio = msoTrue

                .ScaleWidth 0.005 * oPic.Width, msoTrue

            End With

            Set oPic = Nothing

            Set logoPic = Nothing

        Next vrtSelectedItem

    End If

End With



For i = 1 To numPics    'Groups pictures on slide

    Set osldGroup = ActivePresentation.Slides(i)

    ActivePresentation.Slides(i).Select

    ActiveWindow.Selection.Unselect

    For Each oshp In osldGroup.Shapes

    If oshp.Type = msoPicture Then oshp.Select Replace:=False

    Next oshp

    With ActiveWindow.Selection.ShapeRange

    If .Count > 1 Then

    .Group

    End If

    End With

Next i



Dim ap As Presentation: Set ap = ActivePresentation

Dim sl As Slide

Dim shGroup As ShapeRange

For Each sl In ap.Slides

    ActiveWindow.View.GotoSlide (sl.SlideIndex)

    sl.Shapes.SelectAll

    Set shGroup = ActiveWindow.Selection.ShapeRange

    shGroup.Export filePath(sl.SlideIndex) & "" & fileName(sl.SlideIndex) & "_with logo" & ".jpg", ppShapeFormatJPG, , , ppScaleXY

Next



Set fd = Nothing

Dim v As Long

For v = 1 To Application.ActivePresentation.Slides.Count

    ActivePresentation.Slides.Range(1).Delete

Next v



End Sub