How get i get an AddedPicture center on a page word - vba

Question

To get around the fact that the manual way to insert a pdf in a word don't give really good quality result.
I'm trying to insert pictures that have been nicely converted from a pdf to png with Imagemagick in a word with a macro.
The moment where i struggle is when i want the picture to get in a middle of each page and don't overlap each over.
I come up with this but i don't understand why it seems that AllowOverlap and wdShapeCenter do nothing while wdWrapTopBottom work properly. The picture get stuck to the top-left corner'
Sub Test()
Dim objShape As Shape
strPath = "Some.png"
'insert the image
Set objShape = ActiveDocument.Shapes.AddPicture( _
FileName:=strPath, LinkToFile:=False, _
SaveWithDocument:=True)
objShape.WrapFormat.AllowOverlap = False
objShape.Top = WdShapePosition.wdShapeCenter
objShape.WrapFormat.Type = wdWrapTopBottom
End Sub
I tried to use Selection.InlineShapes.AddPicture to resolve the overlap problem but i can't get the picture move from the top-left corner neither.
Thanks for your help

Answer 1

For example:
Sub Demo()
Application.ScreenUpdating = False
Dim Shp As Shape
With Dialogs(wdDialogInsertPicture)
.Display
If .Name <> "" Then
Set Shp = ActiveDocument.Shapes.AddPicture(FileName:=.Name, _
LinkToFile:=False, SaveWithDocument:=True, Anchor:=Selection.Range)
With Shp
.LockAspectRatio = True
.Height = InchesToPoints(2)
.RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin
.Left = wdShapeCenter
.RelativeVerticalPosition = wdRelativeVerticalPositionMargin
.Top = wdShapeCenter
.WrapFormat.AllowOverlap = False
End With
End If
End With
Application.ScreenUpdating = True
End Sub
With the above code, the inserted pic will be positioned in the center of the page. If there's already one centered there, the existing pic will be pushed down.
In light of your additional information, you should use something like:
Sub Demo()
Application.ScreenUpdating = False
Dim iShp As InlineShape, sWdth As Single, sHght As Single
With Dialogs(wdDialogInsertPicture)
.Display
If .Name <> "" Then
Set Shp = .InlineShapes.AddPicture(FileName:=.Name, _
LinkToFile:=False, SaveWithDocument:=True, Range:=Selection.Range)
With ActiveDocument.PageSetup
sWdth = .PageWidth - .LeftMargin - .RightMargin
sHght = .PageHeight - .TopMargin - .LeftMargin
End With
With iShp
.LockAspectRatio = True
.Width = sWdth
If .Height > sHght Then .Height = sHght
End With
End If
End With
Application.ScreenUpdating = True
End Sub

Answer 2

Finaly with your help I come up with this.
It center and place on it's own page pictures from a Folder.
Sub Folder_Picture_To_Word()
Dim shp As Shape
Dim intResult As Integer
Dim strPath As String
Dim strFolderPath As String
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
'the dialog is displayed to the user
intResult = Application.FileDialog(msoFileDialogFolderPicker).Show
'checks if user has cancled the dialog
If intResult <> 0 Then
'dispaly message box
strFolderPath = Application.FileDialog(msoFileDialogFolderPicker _
).SelectedItems(1)
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(strFolderPath)
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'get file path
strPath = objFile.Path
Selection.InsertAfter ChrW(12)
'insert the image
Set shp = ActiveDocument.Shapes.AddPicture(FileName:=strPath, _
LinkToFile:=False, SaveWithDocument:=True, Anchor:=Selection.Range)
With shp
'.LockAspectRatio = True
'.Height = InchesToPoints(8)
.RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin
.Left = wdShapeCenter
.RelativeVerticalPosition = wdRelativeVerticalPositionMargin
.Top = wdShapeCenter
.WrapFormat.Type = wdWrapTopBottom
.WrapFormat.AllowOverlap = False
End With
'Go to next Page to get ready for a new picture
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext
Next objFile
Selection.GoTo What:=wdGoToPage, Which:=wdGoToPrevious 'Go to second last page
'To delete the extra jump page made in the loop
Selection.Delete
End If
End Sub