Consulting

Results 1 to 5 of 5

Thread: Coding works for WORD but not POWERPOINT, how should i modify it?

  1. #1
    VBAX Newbie
    Joined
    Mar 2023
    Posts
    2
    Location

    Coding works for WORD but not POWERPOINT, how should i modify it?

    I would like to insert every 6 pictures in a new slide of powerpoint with it's file name at the centre bottom of the image itself.

    The below coding works for word but not on powerpoint and i would like to do further editing.

    1) modify coding so it'll work on powerpoint as well
    2) current in word it's showing 1 image per page, can we modify to show 6 images per slide when it comes to powerpoint?
    3) the file name in word currently showing the format of the file e.g. jpg / .png, how could i skip that?
    4) the file name is showing on the bottom left in word, how can i make it centre bottom?


    Sub PicWithCaption()
        Dim xFileDialog As FileDialog
        Dim xPath, xFile As Variant
        On Error Resume Next
        Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
        If xFileDialog.Show = -1 Then
            xPath = xFileDialog.SelectedItems.Item(1)
            If xPath <> "" Then
                xFile = Dir(xPath & "\*.*")
               Do While xFile <> ""
                   If UCase(Right(xFile, 3)) = "PNG" Or _
                       UCase(Right(xFile, 3)) = "TIF" Or _
                       UCase(Right(xFile, 3)) = "JPG" Or _
                       UCase(Right(xFile, 3)) = "GIF" Or _
                       UCase(Right(xFile, 3)) = "BMP" Then
                       With Selection
                           .InlineShapes.AddPicture xPath & "" & xFile, False, True
                           .InsertAfter vbCrLf
                           .MoveDown wdLine
                           .Text = xFile & Chr(10)
                           .MoveDown wdLine
                       End With
                   End If
                   xFile = Dir()
                Loop
            End If
        End If
    End Sub
    Last edited by Aussiebear; 03-02-2025 at 04:29 AM. Reason: Added code tags to supplied code

  2. #2
    VBAX Mentor
    Joined
    Nov 2022
    Location
    The Great Land
    Posts
    419
    Location
    Note for future: post code between CODE tags to retain indentation and readability.

    1. I don't think InlineShapes is valid in PP. Use Shapes. I doubt the exact same code can be used for both Word and PP.

    2. Don't see why not. Example of adding image:
    With .Shapes.AddShape(msoShapeRectangle, 360, 121, 220, 110) 'photo
          .Fill.UserPicture "image path\name"
    End With
    3. Use string manipulation functions to truncate filename: Left(xFile, InStrRev(xFile, ".") - 1).

    4. Try: .ParagraphFormat.Alignment = wdAlignParagraphCenter
    Last edited by Aussiebear; 03-02-2025 at 04:29 AM.
    How to attach file: Reading and Posting Messages (vbaexpress.com), click Go Advanced below post edit window. To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  3. #3
    VBAX Newbie
    Joined
    Mar 2023
    Posts
    2
    Location
    Thanks! i tried to modify the code just now and it works on powerpoint but still i would like to update some functions

    1) it doesn't work when the file is at .jpeg
    2) the image is now resize, how should i keep it as it's own proportion?
    3) images are now on the left of the slide, how can i keep it centred?



    Sub PicWithCaption()
        Dim xFileDialog As FileDialog
        Dim xPath As String, xFile As String, xFileName As String
        Dim oSlide As Slide
        Dim oShape As Shape
        Dim i As Long, j As Long
        Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
        xFileDialog.Title = "Select a folder with pictures"
        If xFileDialog.Show = -1 Then
            xPath = xFileDialog.SelectedItems(1)
            If xPath <> "" Then
                xFile = Dir(xPath & "\*.*")
                j = 0
               Do While xFile <> ""
                   If UCase(Right(xFile, 3)) = "PNG" Or _
                       UCase(Right(xFile, 3)) = "TIF" Or _
                       UCase(Right(xFile, 3)) = "JPG" Or _
                       UCase(Right(xFile, 3)) = "GIF" Or _
                       UCase(Right(xFile, 3)) = "BMP" Then
                       xFileName = Left(xFile, Len(xFile) - 4)
                       If j Mod 6 = 0 Then
                           Set oSlide = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutBlank)
                       End If
                       i = j Mod 3
                       If j Mod 6 < 3 Then
                          Set oShape = oSlide.Shapes.AddPicture(FileName:=xPath & "" & xFile, _
                          LinkToFile:=msoFalse, _
                          SaveWithDocument:=msoTrue, _
                          Left:=100 + i * 150, _
                          Top:=100, _
                          Width:=120, _
                          Height:=90)
                      Else
                           Set oShape = oSlide.Shapes.AddPicture(FileName:=xPath & "" & xFile, _
                           LinkToFile:=msoFalse, _
                           SaveWithDocument:=msoTrue, _
                           Left:=100 + i * 150, _
                           Top:=250, _
                           Width:=120, _
                           Height:=90)
                       End If
                       oShape.Name = xFileName
                       Set oShape = oSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, _
                       Left:=100 + i * 150, _
                       Top:=oShape.Top + oShape.Height + 10, _
                       Width:=120, _
                       Height:=20)
                       oShape.TextFrame.TextRange.Text = xFileName
                       j = j + 1
                   End If
                   xFile = Dir()
                Loop
            End If
        End If
    End Sub

    Quote Originally Posted by June7 View Post
    Note for future: post code between CODE tags to retain indentation and readability.

    1. I don't think InlineShapes is valid in PP. Use Shapes. I doubt the exact same code can be used for both Word and PP.

    2. Don't see why not. Example of adding image:
    With .Shapes.AddShape(msoShapeRectangle, 360, 121, 220, 110) 'photo
          .Fill.UserPicture "image path\name"
    End With
    3. Use string manipulation functions to truncate filename: Left(xFile, InStrRev(xFile, ".") - 1).

    4. Try: .ParagraphFormat.Alignment = wdAlignParagraphCenter
    Last edited by Aussiebear; 03-02-2025 at 04:33 AM. Reason: added code tags to supplied code

  4. #4
    VBAX Mentor
    Joined
    Nov 2022
    Location
    The Great Land
    Posts
    419
    Location
    Please, post code between CODE tags.

    I used jpg in my test.

    I don't have answers to your questions at hand. Would have to do web search and testing. Did you do that?
    How to attach file: Reading and Posting Messages (vbaexpress.com), click Go Advanced below post edit window. To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  5. #5
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,096
    Location
    This is top of head code but might give you a pointer

    Sub PicWithCaption()
        Dim xFileDialog As FileDialog
        Dim xPath As String, xFile As String, xFileName As String
        Dim oSlide As Slide
        Dim oShape As Shape
        Dim i As Long, j As Long
        Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
        xFileDialog.Title = "Select a folder with pictures"
        If xFileDialog.Show = -1 Then
            xPath = xFileDialog.SelectedItems(1)
            If xPath <> "" Then
                xFile = Dir(xPath & "\*.*")
                 j = 0
                Do While xFile <> ""
                    If UCase(Right(xFile, 3)) = "PNG" Or _
                    UCase(Right(xFile, 3)) = "TIF" Or _
                    UCase(Right(xFile, 3)) = "JPG" Or _
                    UCase(Right(xFile, 4)) = "JPEG" Or _
                    UCase(Right(xFile, 3)) = "GIF" Or _
                    UCase(Right(xFile, 3)) = "BMP" Then
                    xFileName = Left(xFile, Len(xFile) - 4)
                    If j Mod 6 = 0 Then
                        Set oSlide = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutBlank)
                        ActiveWindow.View.GotoSlide oSlide.SlideIndex
                   End If
                   i = j Mod 3
                   If j Mod 6 < 3 Then
                       Set oShape = oSlide.Shapes.AddPicture(FileName:=xPath & "\" & xFile, _
                       LinkToFile:=msoFalse, _
                       SaveWithDocument:=msoTrue, _
                       Left:=100 + i * 150, _
                       Top:=100)
                       oShape.LockAspectRatio = msoCTrue
                       oShape.Width = 120
                       oShape.Select False
                       Set oShape = oSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, _
                       Left:=100 + i * 150, _
                       Top:=oShape.Top + oShape.Height + 10, _
                       Width:=120, _
                       Height:=20)
                       oShape.Select False
                       oShape.TextFrame.TextRange.Text = xFileName
                       oShape.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter
                    Else
                        Set oShape = oSlide.Shapes.AddPicture(FileName:=xPath & "\" & xFile, _
                        LinkToFile:=msoFalse, _
                        SaveWithDocument:=msoTrue, _
                        Left:=100 + i * 150, _
                        Top:=250)
                        oShape.LockAspectRatio = msoCTrue
                        oShape.Width = 120
                        oShape.Select False
                        Set oShape = oSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, _
                        Left:=100 + i * 150, _
                        Top:=oShape.Top + oShape.Height + 10, _
                        Width:=120, _
                        Height:=20)
                        oShape.TextFrame.TextRange.Text = xFileName
                        oShape.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter
                        oShape.Select False
                    End If
                    j = j + 1
                    If j Mod 6 = 0 And j <> 0 Then
                        With ActiveWindow.Selection.ShapeRange.Group
                            .Left = ActivePresentation.PageSetup.SlideWidth / 2 - .Width / 2
                            .Ungroup
                         End With
                      End If.        
                   End If
                   xFile = Dir()
               Loop
            End If
        End If
    End Sub
    Last edited by Aussiebear; 03-02-2025 at 04:38 AM.
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

Posting Permissions

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