' Browse for folderSub ImportAndResizeImages9() Dim sr As ShapeRange Dim shPIC As shape Dim file As Variant Dim selectionWidth As Double Dim selectionHeight As Double Dim imageWidth As Double Dim imageHeight As Double Dim resizeFactor As Double Dim openFileDialog As Object Dim sel As ShapeRange
' Get active selection Set sel = ActiveSelectionRange
' Create a file dialog object Set openFileDialog = CreateObject("Shell.Application").BrowseForFolder(0, "Select Images to Import", 0, 0)
' Import and resize images For Each file In openFileDialog.Items Set shPIC = ActiveLayer.ImportBitmap(file.Path)
' Get dimensions of the selection and the imported image selectionWidth = sel.SizeWidth selectionHeight = sel.SizeHeight imageWidth = shPIC.SizeWidth imageHeight = shPIC.SizeHeight
' Calculate resize factor to fit the image to the selection proportionately resizeFactor = IIf(imageWidth > imageHeight, selectionWidth / imageWidth, selectionHeight / imageHeight)
' Resize the image proportionately shPIC.SizeWidth = imageWidth * resizeFactor shPIC.SizeHeight = imageHeight * resizeFactor
' Move the image shPIC.Move 2, 0
' Release the shape object Set shPIC = Nothing Next file
' Release the dialog object Set openFileDialog = NothingEnd Sub