We help IT Professionals succeed at work.

Resizing two pictures to different sizes

Medium Priority
359 Views
Last Modified: 2012-06-27
Hello Experts,
I am copying pictures from access to excel via VBA and during the process i am resizing the pictures.  I have a code extract below which resizes all pictures to one common size but i want to size each one individually.  Could someone please recommend what to change in the code.
Thanks.

Dim appExcel As Excel.Application
    Dim wbook As Excel.Workbook
    Dim wsheet As Excel.Worksheet
    Dim myPict As Excel.Picture
    Dim myLogo As Excel.Picture
    Dim pSize As Shape
    Dim ProcessCloseDate As Date
    Dim ReportDate As Date
   
    ProcessCloseDate = Me.SCRDate + 14
    ReportDate = Me.SCRDate + 7
   
    Set appExcel = New Excel.Application
    appExcel.Visible = False
    appExcel.DisplayAlerts = False
    Set wbook = appExcel.Workbooks.Open("f:\Quality Systems\Supplier Concerns\Associated Documents\" & StrFileName2)
    Set wsheet = wbook.Worksheets("SCR Report")
       
    If ("f:\Quality Systems\Supplier Concerns\Photos\") & Dir("f:\Quality Systems\Supplier Concerns\Photos\" & strPhotoname) <> "" Then
     
    With wsheet.Range("e59")
            Set myPict = .Parent.Pictures.Insert("f:\Quality Systems\Supplier Concerns\Photos\" & strPhotoname)
            myPict.Top = .Top
            myPict.Left = .Left
            myPict.Placement = xlMoveAndSize
    End With
   
    End If
   
    If ("f:\Quality Systems\Supplier Concerns\Photos\") & Dir("f:\Quality Systems\Supplier Concerns\Photos\" & strLogo) <> "" Then
     
    With wsheet.Range("aj7")
            Set myLogo = .Parent.Pictures.Insert("f:\Quality Systems\Supplier Concerns\Photos\" & strLogo)
            myLogo.Top = .Top
            myLogo.Left = .Left
            myLogo.Placement = xlMoveAndSize
           
    End With
   
    End If
   
    For Each psize In wsheet.Shapes
            pSize.LockAspectRatio = msoTrue
            pSize.Height = 280
            pSize.Width = 288
    Next pSize
Comment
Watch Question

Saqib HusainEngineer
CERTIFIED EXPERT

Commented:
It is the last 5 lines of code which are controlling the size of the picture. How do you want to change the sizes?

Author

Commented:
I want to change them the same way but i want each of the two piictures a diffrent size not the samesize
Engineer
CERTIFIED EXPERT
Commented:
Unlock this solution and get a sample of our free trial.
(No credit card required)
UNLOCK SOLUTION

Author

Commented:
Very close (needed to add shape range in aspect ratio line) but nevertheless your suggestion lead me to the solution nicely, see below.
Thanks

If ("f:\Quality Systems\Supplier Concerns\Photos\") & Dir("f:\Quality Systems\Supplier Concerns\Photos\" & strPhotoname) <> "" Then
     
    With wsheet.Range("E59")
            Set myPict = .Parent.Pictures.Insert("f:\Quality Systems\Supplier Concerns\Photos\" & strPhotoname)
            myPict.Top = .Top
            myPict.Left = .Left
            myPict.Placement = xlMoveAndSize
            myPict.ShapeRange.LockAspectRatio = msoFalse
            myPict.Height = 280
            myPict.Width = 288
    End With
   
    End If
     
    If ("f:\Quality Systems\Supplier Concerns\Photos\") & Dir("f:\Quality Systems\Supplier Concerns\Photos\" & strLogo) <> "" Then

    With wsheet.Range("aj7")
            Set myLogo = .Parent.Pictures.Insert("f:\Quality Systems\Supplier Concerns\Photos\" & strLogo)
            myLogo.Top = .Top
            myLogo.Left = .Left
            myLogo.Placement = xlMoveAndSize
            myLogo.ShapeRange.LockAspectRatio = msoFalse
            myLogo.Height = 70
            myLogo.Width = 170
    End With

    End If

Author

Commented:
To get the solution to work i needed to change the lockaspectratio line slightly, see my posting.
Saqib HusainEngineer
CERTIFIED EXPERT

Commented:
The solution I provided was in complete as far as the question and the follow up is concerned.

Your follow up comment says "...change them the same way..." which means that only the size needs to be changed.

You did not, at any stage, ask for a change in the aspect ratio (which would distort the picture) from the original. Had you asked for that I would have given it to you.

So in all fairness this should have been an A grade. Please reopen this question and reassign an A grade.

Saqib HusainEngineer
CERTIFIED EXPERT

Commented:
Modalot,

Points apart, I am glad you said that.

Thanks for the consideration.

Saqib
Unlock the solution to this question.
Thanks for using Experts Exchange.

Please provide your email to receive a sample view!

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.