Mass Image Formatting

[Llewellyn]

Hi there,

I've been searching online for some answers to this problem for a few days now but not found anything that I was capable of adapting to fit my own needs so I'm posting this as something of a last resort. Hopefully someone here can help me!

I was just wondering if I could get some advice and a nudge in the right direction; I'm trying to help speed up the process in our department of compiling reports, part of which consists of inserting and formatting dozens of charts (saved as .png files) to a certain height, width and text wrapping style.

I've been working on the code for parts of this in my spare time but I am struggling to put all the pieces together.

Currently I have this piece of code that inserts the images,


Sub InsertImages()
Dim doc As Word.Document
Dim fileOpenDialog As FileDialog
Dim vItem As Variant
Dim mg1 As Range
Dim mg2 As Range
Set fileOpenDialog = Application.FileDialog(msoFileDialogFilePicker)
Set doc = ActiveDocument
With fileOpenDialog
'.Filters.Add "Images", "*.gif; *.jpg; *.jpeg *.png", 1
.Filters.Add "Images", "*.png", 1
If .Show = -1 Then
For Each vItem In .SelectedItems
Set mg2 = ActiveDocument.Range
mg2.Collapse wdCollapseEnd
doc.InlineShapes.AddPicture _
FileName:=vItem, _
LinkToFile:=False, SaveWithDocument:=True, Range:=mg2
Set mg1 = ActiveDocument.Range
mg1.Collapse wdCollapseEnd
mg1.Text = vbCrLf & vbCrLf
Next vItem
End If
End With
Set fd = Nothing
End Sub


And this piece of code that formats a single image in the correct way:


Sub PictureFormatting()
Dim myShape As Shape

If Selection.InlineShapes.Count > 0 Then
Set myShape = Selection.InlineShapes(1).ConvertToShape
ElseIf Selection.ShapeRange.Count > 0 Then
Set myShape = Selection.ShapeRange(1)
Else
Exit Sub
End If

With myShape
.LockAspectRatio = False
.Height = InchesToPoints(5.51)
.Width = InchesToPoints(9.54)
.WrapFormat.Type = wdWrapTopBottom
.WrapFormat.DistanceTop = InchesToPoints(0.2)
.WrapFormat.DistanceBottom = InchesToPoints(0.2)
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.Left = wdShapeCenter
End With
End Sub

Ideally this piece of code needs to be applied to every image that gets inserted at the end of each report; of which there are sometimes upwards of 60. When we have multiple reports to write in a single day it becomes very time consuming to make sure each one is a uniform height and width and centered in the middle of each page correctly.

My hope is to have the fileDialog let us select which images to insert, and then follow it up by automatically inserting page breaks between each image and formatting them to the aforementioned dimensions.
I've also attached an example of the end section of one of our reports so you can get an idea of how the final result would hopefully look. 11724

I'll admit I'm not entirely sure on the feasibility of this, I'm not very experienced at visual basic so as I mentioned it's all slightly beyond me; any help you can give me would be vastly appreciated!

Thank you in advance for the help!

[gmaxey]

This is not a specific answer to you question, but I was wondering if you might be able to use this (or a variation of it): http://gregmaxey.mvps.org/word_tip_pages/photo_gallery_add_in.html

[macropod]

It seems to me that all you need do is to integrate the code from the second sub into the first one:

Sub InsertImages()
Dim doc As Word.Document
Dim fileOpenDialog As FileDialog
Dim vItem As Variant
Dim mg1 As Range
Dim mg2 As Range
Dim iShp As InlineShape
Dim Shp As Shape
Set fileOpenDialog = Application.FileDialog(msoFileDialogFilePicker)
Set doc = ActiveDocument
With fileOpenDialog
'.Filters.Add "Images", "*.gif; *.jpg; *.jpeg *.png", 1
.Filters.Add "Images", "*.png", 1
If .Show = -1 Then
For Each vItem In .SelectedItems
Set mg2 = ActiveDocument.Range
mg2.Collapse wdCollapseEnd
Set iShp = doc.InlineShapes.AddPicture( _
FileName:=vItem, LinkToFile:=False, _
SaveWithDocument:=True, Range:=mg2)
Set Shp = iShp.ConvertToShape
With Shp
.LockAspectRatio = False
.Height = InchesToPoints(5.51)
.Width = InchesToPoints(9.54)
.WrapFormat.Type = wdWrapTopBottom
.WrapFormat.DistanceTop = InchesToPoints(0.2)
.WrapFormat.DistanceBottom = InchesToPoints(0.2)
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.Left = wdShapeCenter
End With
Set mg1 = ActiveDocument.Range
mg1.Collapse wdCollapseEnd
mg1.Text = vbCrLf & vbCrLf
Next vItem
End If
End With
Set fd = Nothing
End Sub

[Llewellyn]

Macropod,

Thank you for the quick reply, that seems to be working almost perfectly, thank you!

There's just a slight issue where extra paragraph spaces are being added resulting in blank pages between every image... Can't see anything that would explicitly cause that in the code though, and it's not too much of an issue for us to delete the extra pages afterwards. Certainly a quicker job than inserting all the images and formatting them individually like before! :)

Thanks again for the help!

[macropod]

You could delete one vbCrLf from vbCrLf & vbCrLf

[Llewellyn]

Yeah thanks! I was about to edit my post saying I worked out that I needed to get rid of one of them but you snuck in before I could :)

Seems to be working perfectly now, thank you for the help mate!