Importing pictures and re scaling
This may give you an idea:
Option Explicit
Sub testme02()
Dim myPicNames As Variant
Dim myPict As Picture
Dim myAddresses As Variant
Dim myRng As Range
Dim iCtr As Long
myPicNames = Array("c:\pict1.jpg", _
"C:\pict2.jpg")
myAddresses = Array("a1:c3", "e1:g3")
If UBound(myPicNames) < UBound(myAddresses) Then
MsgBox "design error"
Exit Sub
End If
With Worksheets("sheet1")
For iCtr = LBound(myPicNames) To UBound(myPicNames)
Set myRng = .Range(myAddresses(iCtr))
Set myPict = .Pictures.Insert(myPicNames(iCtr))
myPict.Top = myRng.Top
myPict.Width = myRng.Width
myPict.Height = myRng.Height
myPict.Left = myRng.Left
myPict.Placement = xlMoveAndSize
Next iCtr
End With
End Sub
ChrisP wrote:
Im going to import lots of pictures into my spreadsheet and they are all the
same original size. I have to import them 1 by 1 and rescale them to 20% of
the original size. It would also be sweet if it was possible to rescale them
to the the size of the cell its being imported into.
I have searched all over to find a way to do this, anyone know how to do it?
(I dont want to use another prog to rescale the pictures)
thanks!
Chris
--
Dave Peterson
|