ambro
03-25-2019, 11:49 AM
Below is a macro I found that I recently started using. As I use it more, I've been refining/adding to it to suit my application. A few functional adds I would like but cannot figure out:
Major issue is that it does not always pull filenames in ascending order. Sometimes it does, sometimes the order is seemingly random. I cannot figure out a pattern for it. Would love if the code can be modified such that images are pulled in ascending filename order.
Change image size for each picture as it is being inserted. Width = 4.33 inches; Height = 3.25 inches
Format text = Black at the start of the macro
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
.ParagraphFormat.Alignment = wdAlignParagraphCenter
.InlineShapes.AddPicture xPath & "\" & xFile, False, True
.InsertAfter vbCrLf
.MoveDown wdLine
.Text = xFile & Chr(10)
.MoveDown wdLine
.TypeParagraph
.TypeParagraph
End With
End If
xFile = Dir()
Loop
End If
End If
End Sub
Any help is appreciated! I have very little VBA experience, learning on the fly.
Major issue is that it does not always pull filenames in ascending order. Sometimes it does, sometimes the order is seemingly random. I cannot figure out a pattern for it. Would love if the code can be modified such that images are pulled in ascending filename order.
Change image size for each picture as it is being inserted. Width = 4.33 inches; Height = 3.25 inches
Format text = Black at the start of the macro
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
.ParagraphFormat.Alignment = wdAlignParagraphCenter
.InlineShapes.AddPicture xPath & "\" & xFile, False, True
.InsertAfter vbCrLf
.MoveDown wdLine
.Text = xFile & Chr(10)
.MoveDown wdLine
.TypeParagraph
.TypeParagraph
End With
End If
xFile = Dir()
Loop
End If
End If
End Sub
Any help is appreciated! I have very little VBA experience, learning on the fly.