0

I have a macro that, from a chosen folder, input and resize all images inside a word document.

  • When we choose a folder from a laptop's drive, the macro works well.

  • However, when we choose a folder stored inside a network (company's network), images aren't insert in the good order.

I would like to display images exactly how they are stored inside the folder: by name order.

As any one have an idea how to fix this problem?

Here is my macro:

Attribute VB_Name = "InsertImagesAnnexes"

Option Explicit

Sub InsertImagesAnnexes()
    Dim FolderPath, objFSO, Folder, ImagePath, image, countphoto As Integer
    Const END_OF_STORY = 6
    Const MOVE_SELECTION = 0
    countphoto = 0
    FolderPath = Select_Folder_From_Prompt
    If InStr(FolderPath, "EMPTY") = 0 Then
        Set objFSO = CreateObject("Scripting.Filesystemobject")
        Set Folder = objFSO.GetFolder(FolderPath)
        For Each image In Folder.Files
            ImagePath = image.Path
            If CheckiImageExtension(ImagePath) = True Then
                Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
                Selection.Font.Name = "Times New Roman"
                Selection.Font.Size = "12"
                If countphoto = 0 Then
                    Application.Selection.InsertBreak  'Insert a pagebreak
                    Selection.TypeText Text:="ANNEXES PHOTOGRAPHIQUES" & Chr(11) & Chr(11)
                    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
                Else
                    Application.Selection.EndKey END_OF_STORY, MOVE_SELECTION
                    Application.Selection.InlineShapes.AddPicture (ImagePath)
                    Selection.TypeText Text:=Chr(11) & Chr(11) & "PHOTO N°" & countphoto & Chr(11) & Chr(11) & Chr(11)
                End If
                countphoto = countphoto + 1
            End If
        Next
    End If
End Sub


Function Select_Folder_From_Prompt() As String

    Dim fd, bMultiSelect, CONST_MODEL_DIRECTORY
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)

    With fd
        .Title = "Select a folder"
        .AllowMultiSelect = bMultiSelect
        .InitialFileName = CONST_MODEL_DIRECTORY
        .Filters.Clear

         'Use the Show method to display the File Picker dialog box and return the user's action.
         'The user pressed the action button.
        If .Show = -1 Then
            Select_Folder_From_Prompt = .SelectedItems(1) & "\"
        Else
            Select_Folder_From_Prompt = "EMPTY"
        End If
    End With

End Function


Function CheckiImageExtension(ImagePath)
    Dim varArray        ' An array contains iamge file extensions.
    Dim varEach         ' Each iamge file extension.
    Dim blnIsPptFile    ' Whether the file extension is image file extension.
    Dim objFSO, file, FileExtension
    Set objFSO = CreateObject("Scripting.Filesystemobject")
    Set file = objFSO.GetFile(ImagePath)
    FileExtension = file.Name
    blnIsPptFile = False
    If FileExtension <> "" Then
        varArray = Array(".emf", ".wmf", ".jpg", ".jpeg", ".jfif", ".png", ".jpe", ".bmp", ".dib", ".rle", ".gif", ".emz", ".wmz", ".pcz", ".tif", ".tiff", ".eps", ".pct", ".pict", ".wpg")
        For Each varEach In varArray
            If InStrRev(UCase(FileExtension), UCase(varEach)) <> 0 Then
                blnIsPptFile = True
                Exit For
            End If
        Next
    End If
    CheckiImageExtension = blnIsPptFile
    Set objFSO = Nothing
    Set file = Nothing
End Function
YowE3K
  • 23,852
  • 7
  • 26
  • 40
Romain
  • 407
  • 2
  • 9
  • 20

0 Answers0