Macro to insert images in a document

[Dzib]

Hi,


I've found this macro that works fine to insert a whole folder of images in a word document. The only problem is that the images are inserted in a random order. Any idea how to insert them in alphabetical order?

Sub InsertSpecificNumberOfPictureForEachPage()
    Dim StrFolder As String
    Dim strFile As String
    Dim objDoc As Document
    Dim dlgFile As FileDialog
    Dim objInlineShape As InlineShape
    Dim nResponse As Integer
    Dim strPictureNumber As Integer
    Dim strPictureSize As String
    Dim n As Integer  
   
    Set dlgFile = Application.FileDialog(msoFileDialogFolderPicker)
    
    With dlgFile
      If .Show = -1 Then
        StrFolder = .SelectedItems(1) & "\"
      Else
        MsgBox ("No Folder is selected!")
        Exit Sub
      End If
    End With
   
    strFile = Dir(StrFolder & "*.*", vbNormal)
    strPictureNumber = InputBox("Input the number of the picture for each page", "Picture Number", "For exemple: 1")
    n = 1  
   
    While strFile <> ""
      Selection.InlineShapes.AddPicture FileName:=StrFolder & strFile, LinkToFile:=False, SaveWithDocument:=True
      Selection.TypeParagraph
      Selection.Collapse Direction:=wdCollapsEnd
      Selection.TypeText Text:=Left(strFile, InStrRev(strFile, ".") - 1)
      Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
      If ActiveDocument.InlineShapes.Count = strPictureNumber * n Then
        Selection.InsertNewPage
        Selection.TypeBackspace
        n = n + 1
      End If
      Selection.TypeParagraph
      strFile = Dir()
    Wend
   
    For Each objInlineShape In ActiveDocument.InlineShapes
      objInlineShape.Select
      Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    Next objInlineShape
   
    nResponse = MsgBox("Do you want to resize all pictures?", 4, "Resize Picture")
    If nResponse = 6 Then
      strPictureSize = InputBox("Input the height and width of the picture, seperated by comma", "Height and Width", "For exemple:500,500")
      For Each objInlineShape In ActiveDocument.InlineShapes
        objInlineShape.Height = Split(strPictureSize, ",")(0)
        objInlineShape.Width = Split(strPictureSize, ",")(1)
      Next objInlineShape
    End If
  End Sub

[gmaxey]

See Photo Gallery Add-In


And I have a premium version that does lots more.

[Dzib]

Looks like it doesn't work with Office 2019

[gmaxey]

That isn't very helpful. What isn't working?


Please try again with the attached and let me know what (if any errors) you get. Are you using a 64 bit version of Office?

[Dzib]

Originally Posted by gmaxey

That isn't very helpful. What isn't working?


Please try again with the attached and let me know what (if any errors) you get. Are you using a 64 bit version of Office?

Don't know why but it didn't worked at home but works fine at work. Thank you so much.
I'll try again and let you know 😉

[gmaxey]

Did you use the file I attached at work or the one you downloaded? I expect the issue is with a 64 bit version of office installed at home and I don't think the file on the website was updated to account for that. Please try the file I attached both at home and work and advise if you have issues.

[Dzib]

I've used the file attached at work and the downloaded at home.
Now the attached one works perfectly fine at home too

[gmaxey]

Ok, the website is updated with the file I sent you as an attachment. Thanks.

[Dzib]

Thanks gmaxey for this amazing tool, save me lot of time...
One question, is it possible to have a custom caption text that saves in configuration window?
I use the text Foto (in dutch) but I have to rewrite it every time I insert new pictures.

[gmaxey]

Yes, it is possible and wouldn't take any more effort than the "Donate" button which you are apparently yet to discover!!


If you want, contact me privately to arrange fee based consulting services.