Sub aaInsertImagesOneToAPage()

Sub aaInsertImagesOneToAPage()

    Dim doc As Word.Document
    Dim fd As FileDialog
    Dim vItem As Variant
    Dim mg1 As Range
    Dim mg2 As Range
    Dim intCount As Integer
    Dim strTotal As String
    strTotal = ""
    intCount = 0
 

    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    Set doc = ActiveDocument

    Dim shapePicture As InlineShape
 
   ' Set the width or the height
    Dim intSetWidth
    Dim intSetHeight
    intSetWidth = 350
    intSetHeight = 350
    Dim dblPercentChange As Double
    dblPercentChange = 1

    '==Prompt user for Case Title:
    Dim strCaseTitle As String
    strCaseTitle = InputBox("Enter a title for the case :", "Case Title")

     Dim blImageAdjusted As Boolean

    With fd
        .Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp", 1
        .FilterIndex = 1
 
       blImageAdjusted = False
        If .Show = -1 Then
            For Each vItem In .SelectedItems
                intCount = intCount + 1
                Set mg2 = ActiveDocument.Range
                mg2.ParagraphFormat.Alignment = wdAlignParagraphCenter
                mg2.Collapse wdCollapseEnd
             
                Set shapePicture = doc.InlineShapes.AddPicture( _
                  FileName:=vItem, _
                  LinkToFile:=False, SaveWithDocument:=True, Range:=mg2)
               
                 ' Resize portait and landscape picture differently
                ' Resize portrait by height and resize landscape by width
               
                ' Portrait - resize by height
                If shapePicture.Height > shapePicture.Width Then
               
                 ' if we are not the height we we want, resize by percent
                  If shapePicture.Height <> intSetHeight Then
                      blImageAdjusted = True
                     dblPercentChange = CDbl(intSetHeight / shapePicture.Height)
                     shapePicture.Width = shapePicture.Width * dblPercentChange
                     shapePicture.Height = shapePicture.Height * dblPercentChange
                  End If
                Else
                 ' this is for square or landscape images
                 If shapePicture.Width <> intSetWidth Then
                      blImageAdjusted = True
                     dblPercentChange = CDbl(intSetWidth / shapePicture.Width)
                     shapePicture.Width = shapePicture.Width * dblPercentChange
                     shapePicture.Height = shapePicture.Height * dblPercentChange
                  End If
               
                End If ' Portrait or Landscape
               

               
                Set mg1 = ActiveDocument.Range
             
                mg1.Collapse wdCollapseEnd
             
               strTotal = CStr(.SelectedItems.Count)
             
               If strCaseTitle <> "" Then
                mg1.Text = ""
                mg1.Text = vbCrLf + strCaseTitle + ". "
                mg1.Text = mg1.Text + "Height wanted = " + CStr(intSetHeight) + "Actual height=" + CStr(shapePicture.Height)
                mg1.Text = mg1.Text + " Height Percent=" + CStr(dblPercentChange)
                mg1.Text = mg1.Text + "Image: " + CStr(intCount) + " of " + strTotal
                mg1.Text = mg1.Text + vbCrLf + "width=" + CStr(shapePicture.Width) + " height " + CStr(shapePicture.Height)
                If blImageAdjusted Then
                    mg1.Text = mg1.Text + vbCrLf + "Image WAS adjusted" & vbCrLf
                Else
                    mg1.Text = mg1.Text + vbCrLf + "Image was NOT adjusted" & vbCrLf
                End If ' was image adjusted
               
            End If ' strCaseTitle is blank
           
            'Insert a page break
            mg1.InsertBreak (7)
           
           
             
               
               
             
            Next vItem
        End If
    End With

    Set fd = Nothing


End Sub ' InsertImagesOfHeight