title: Problem inconsistent grouping images in Word
body: <p>Using Word 365 to produce a newsletter.  Much of it entails inserting images with attached captions explaining the image.  To speed things up wrote some code to import the edited image from my desktop, (always called 001.jpg), formatting the image and attaching a caption and grouping the caption with the image.  The inconsistent problem is that the code groups them correctly in a new blank document but when the document has a few images the grouping does not work.</p>
  <p>When you are inserting 50+ images in a document it's a pain having to manually group the caption.</p>
  <p>Here is my code, any suggestions would be appreciated</p>
  <pre class="lang-vb prettyprint-override"><code>Sub ImportImages()
  'Imports an image from my desktop called 001.jpg which should be a cropped image ready for moving / manipulating in the docucument
  
  'Keyboard shortcut Ctrl+Shift+S
  
  Dim i As Integer
  
  With ActiveDocument
      
      .Shapes.AddPicture FileName:= _
         &quot;C:\Users\Roger Currier\OneDrive - *********\Desktop\001.jpg&quot;, LinkToFile:=False, SaveWithDocument:=True
          
      With .Shapes.Item(.Shapes.Count)
          .LockAspectRatio = msoTrue
          .Width = CentimetersToPoints(6.26)
          .WrapFormat.Type = wdWrapTight
      End With
      On Error Resume Next
      'find the last shape (picture)inserted have to use the highest count
      i = .Shapes.Count
          'check if the current shape is a picture
          If .Shapes.Item(i).Type = msoPicture Then
              .Shapes.Item(i).Line.Weight = 1
              'change the border style to single
              .Shapes.Item(i).Line.Style = msoLineSingle
              'select the picture
              .Shapes.Item(i).Select
              'assign a caption to it
              Selection.InsertCaption Label:=&quot;Figure&quot;, Title:=&quot;&quot;, Position:=wdCaptionPositionBelow, ExcludeLabel:=True
              'Inserting a caption increases the number of shapes
              .Shapes.Item(i + 1).Line.Weight = 1
              .Shapes.Item(i + 1).Line.Style = msoLineSingle
              .Shapes.Range(Array(.Shapes.Item(i).Name, .Shapes.Item(i + 1).Name)).Group
              'select the group to allow for movement
              .Shapes.Item(.Shapes.Count).Select
              
          End If
  
  End With
          
  End Sub
  </code></pre>