pictures not going to bookmark location when .dotm file is opened by double click ?

[sarveshspace]

Hello all!

I have a document with bookmark 'pretestpics' on page 4 where i would like to bulk insert my photos in table.
I have the code such that whenever i open the .dotm file , i will get pop ups of userforms to fill data.
ie sub document_new()
userform1.show
userform2.show

'and so on and so forth
end sub

When i right click on the .dotm document and open it , i can run the userform and the pictures will go to the bookmark location.
However, when i double click on the .dotm document and the userforms pop up and i select the pics, they will not go to my bookmark but go to the very beginning of the document. How can i fix this ? does it have anything to do with inlineshapes and shapes ? I would like the pics to go to the bookmark location.
here is the code . I have also attached the zip file which contains the .dotm file. Please take a look at userform3 , insert pretest pictures button code .
here it is -

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
Dim i As Long, j As Long, c As Long, r As Long, NumCols As Long
Dim oTbl As Table, TblWdth As Single, StrTxt As String, RwHght As Single
On Error GoTo ErrExit
NumCols = 3
RwHght = CSng(3.8)
On Error GoTo 0
'Select and insert the Pics
With Application.FileDialog(msoFileDialogFilePicker)
  .Title = "Select image files and click OK"
  .Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png"
  .FilterIndex = 2
  .AllowMultiSelect = True
  If .Show = -1 Then
    'Add a 3-row by NumCols-column table to take the images
    Set oTbl = Selection.Tables.Add(Range:=Selection.Range, NumRows:=2, NumColumns:=NumCols)
    Dim orng As Word.Range
    Set ornge = ActiveDocument.Range.Bookmarks("pretestpics").Range
    ActiveDocument.Bookmarks.Add "pretestpics", oTbl.Range
    With ActiveDocument.PageSetup
      TblWdth = .PageWidth - .LeftMargin - .RightMargin - .Gutter
    End With
    With oTbl
      .Borders.Enable = True
      .AutoFitBehavior (wdAutoFitFixed)
      .Columns.Width = InchesToPoints(2.2)
    End With
    CaptionLabels.Add Name:="Picture"
    For i = 1 To .SelectedItems.Count Step NumCols
      r = ((i + 1) / NumCols + 1) * 2 - 1
      'Format the rows
      Call FormatRows3(oTbl, r, RwHght)
      For c = 1 To NumCols
        j = j + 1
        'Insert the Picture
        ActiveDocument.InlineShapes.AddPicture _
          FileName:=.SelectedItems(j), LinkToFile:=False, _
          SaveWithDocument:=True, Range:=oTbl.Cell(r, c).Range

        ' is the problem here? do i need to convert inlineshapes to shapes ? how to do it?
        'Get the Image name for the Caption
        With oTbl.Cell(r - 1, c).Range
          .InsertBefore vbCr
          .Characters.First.InsertCaption _
            Label:="Picture", Title:=StrTxt, _
            Position:=wdCaptionPositionBelow, ExcludeLabel:=False
          .Characters.First = vbNullString
          .Characters.Last.Previous = vbNullString
        End With
        'Exit when we're done
        If j = .SelectedItems.Count Then Exit For
      Next
      'Add extra rows as needed
      If j < .SelectedItems.Count Then
        oTbl.Rows.Add
        oTbl.Rows.Add
      End If
    Next
  Else
  End If
End With
ErrExit:
Application.ScreenUpdating = True
End Sub
'
Sub FormatRows3(oTbl As Table, x As Long, Hght As Single)
With oTbl
  With .Rows(x - 1)
    .Height = CentimetersToPoints(0.5)
    .HeightRule = wdRowHeightExactly
    .Shading.BackgroundPatternColor = wdColorBlack

    With .Range
      .Style = "Normal"
      With .ParagraphFormat
        .SpaceBefore = 0
        .SpaceAfter = 0
      End With
    End With
  End With
  With .Rows(x)
    .Height = CentimetersToPoints(Hght)
    .HeightRule = wdRowHeightExactly
    With .Range
      .Style = "Normal"
      With .ParagraphFormat
        .SpaceBefore = 0
        .SpaceAfter = 0
      End With
    End With
  End With
  End With
End Sub

thank you so much for your help!