Sub CloseExplorer()
'
' CloseExplorer Macro
'
'
End Sub
Sub InsertImages3ToAPage()
Call InsertImagesOfHeight(170)
End Sub
Sub InsertImages()
Call InsertImagesOfHeight(350)
End Sub 'InsertImages()
Sub InsertImagesOfHeight(intHeight)
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
'intSetWidth = 400
Dim dblPercentHeight As Double
dblPercentHeight = 1
'==Prompt user for Case Title:
Dim strCaseTitle As String
strCaseTitle = InputBox("Enter a title for the case :", "Case Title")
With fd
.Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp", 1
.FilterIndex = 1
If .Show = -1 Then
For Each vItem In .SelectedItems
intCount = intCount + 1
Set mg2 = ActiveDocument.Range
mg2.Collapse wdCollapseEnd
Set shapePicture = doc.InlineShapes.AddPicture( _
FileName:=vItem, _
LinkToFile:=False, SaveWithDocument:=True, Range:=mg2)
' if we are bigger than we want, resize by percent
If shapePicture.Height > intHeight Then
dblPercentHeight = CDbl(intHeight / shapePicture.Height)
shapePicture.Width = shapePicture.Width * dblPercentHeight
shapePicture.Height = shapePicture.Height * dblPercentHeight
End If
Set mg1 = ActiveDocument.Range
mg1.Collapse wdCollapseEnd
strTotal = CStr(.SelectedItems.Count)
mg1.Text = ""
mg1.Text = vbCrLf + strCaseTitle + ". "
'mg1.Text = mg1.Text + "Height wanted = " + CStr(intHeight) + "Actual height=" + CStr(shapePicture.Height)
'mg1.Text = mg1.Text + " Height Percent=" + CStr(dblPercentHeight)
mg1.Text = mg1.Text + "Image: " + CStr(intCount) + " of " + strTotal
'mg1.Text = mg1.Text + vbCrLf + "width=" + CStr(shapePicture.Width) + " height " + CStr(shapePicture.Height)
mg1.Text = mg1.Text + vbCrLf & vbCrLf
Next vItem
End If
End With
Set fd = Nothing
End Sub ' InsertImagesOfHeight
