Bulk resizing photo error

[brownhc]

Hi all,

I'm trying to bulk resize inline photos in a word document and I'm running into a problem. I'm using the code below and getting the following error:

Run-time error '-2147467259 (80004005)':
Method 'LockAspectRatio' of object 'InlineShape' failed



Sub ResizePhotos()
Dim pic As InlineShape

For Each pic In ActiveDocument.InlineShapes
With pic
.LockAspectRatio = True
If .Width > .Height Then ' horizontal
.Width = InchesToPoints(7)
Else ' vertical
.Height = InchesToPoints(7)
End If
End With
Next
End Sub



I'm using the following code to insert the images and add captions, which is working fine, but I couldn't figure out how to combine that with resizing, so I opted to resize separately. If it would be easier to combine this all into one thing, that would be super helpful.



Sub PicWithCaption()
Dim file
Dim path As String
path = "(path)"
file = Dir(path & "*.jpg")


CaptionLabels.Add Name:="Filename"
Do While file <> ""
With Selection
.EndKey unit:=wdStory
.InlineShapes.AddPicture FileName:=path & file, _
LinkToFile:=False, SaveWithDocument:=True
.InsertBreak wdSectionBreakNextPage
.Collapse 0
.MoveLeft unit:=wdCharacter, Count:=1
.Style = "Caption"
.Text = vbCrLf & "VDACS " & file
End With
file = Dir()
Loop
Selection.EndKey unit:=wdStory
End Sub



Thanks for your help! If it's not clear, I'm definitely a VBA novice but doing my best to learn.

[gmaxey]

This seems to work without error:


Sub PicWithCaption()
Dim file
Dim path As String
path = "D:\My Pictures\2017-04-06\"
file = Dir(path & "*.jpg")
Dim oILS As InlineShape

CaptionLabels.Add Name:="Filename"
Do While file <> ""
With Selection
.EndKey unit:=wdStory
Set oILS = .InlineShapes.AddPicture(FileName:=path & file, _
LinkToFile:=False, SaveWithDocument:=True)
With oILS
.LockAspectRatio = msoTrue
If .Width > .Height Then ' horizontal
.Width = InchesToPoints(7)
Else ' vertical
.Height = InchesToPoints(7)
End If
End With
.InsertBreak wdSectionBreakNextPage
.Collapse 0
.MoveLeft unit:=wdCharacter, Count:=1
.Style = "Caption"
.Text = vbCrLf & "VDACS " & file
End With
file = Dir()
Loop
Selection.EndKey unit:=wdStory
End Sub

[brownhc]

This works perfectly. Thank you so much!