macro enabled Excel spreadsheet with insert images autofit help

sidfire

New member
Joined
Oct 27, 2011
Messages
3
Reaction score
0
Points
0
Hi all,

This is my first post here, hope someone can help. I have a work related task in which I need to find a way to insert images (from a specified folder - which has another macro for it) by clicking on a command button - the images insert in the H column. However, the problem is that the images from the source are not all of the same size hence they dont actually fit the H column cells ... is there any way this can be automatically done using another macro I suppose,. any help in this matter is appreciated with example codes or fixes - please see attached spreadsheet file template of the same.

Any questions please let me know, I am looking forward to someone helping me out here. Many thanks for looking into this, and please I am still a newbie and go easy with me
smile.gif


cheers,
Sid
 

Attachments

  • Sid spreadsheet - template.xlsm
    48.1 KB · Views: 1,034

Ken Puls

Administrator
Staff member
Joined
Mar 13, 2011
Messages
2,519
Reaction score
4
Points
38
Location
Nanaimo, BC, Canada
Website
www.excelguru.ca
Excel Version(s)
Excel Office 365 Insider
Welcome to the forum,

You've got some pretty inefficient code in there, but maybe this will help. This should scale your picture to fit in the target cell exactly:

Code:
Sub InsertPicture(PictureFileName As String, TargetCell As Range, CenterH As Boolean, CenterV As Boolean)
' inserts a picture at the top left position of TargetCell
' the picture can be centered horizontally and/or vertically
Dim p As Object, t As Double, l As Double, w As Double, h As Double
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    If Dir(PictureFileName) = "" Then Exit Sub
    ' import picture
    Set p = ActiveSheet.Pictures.Insert(PictureFileName)
    ' position picture
    With p
        .Top = TargetCell.Top
        .Left = TargetCell.Left
        .Width = TargetCell.Width
        .Height = TargetCell.Height
    End With
    Set p = Nothing
End Sub

Hope it helps,
 

sidfire

New member
Joined
Oct 27, 2011
Messages
3
Reaction score
0
Points
0
Hi thank you so much for the reply,

Could you advise where should I put that code? should I amend the existing code in the module?


Regards
Sid
 

sidfire

New member
Joined
Oct 27, 2011
Messages
3
Reaction score
0
Points
0
Welcome to the forum,

You've got some pretty inefficient code in there, but maybe this will help. This should scale your picture to fit in the target cell exactly:

Code:
Sub InsertPicture(PictureFileName As String, TargetCell As Range, CenterH As Boolean, CenterV As Boolean)
' inserts a picture at the top left position of TargetCell
' the picture can be centered horizontally and/or vertically
Dim p As Object, t As Double, l As Double, w As Double, h As Double
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    If Dir(PictureFileName) = "" Then Exit Sub
    ' import picture
    Set p = ActiveSheet.Pictures.Insert(PictureFileName)
    ' position picture
    With p
        .Top = TargetCell.Top
        .Left = TargetCell.Left
        .Width = TargetCell.Width
        .Height = TargetCell.Height
    End With
    Set p = Nothing
End Sub

Hope it helps,


Well I got it thanks mate It works great now.. also is it possible to have the H column width and length automatically resize at the same time to say Row Height = 105 and column width 16.5 ???

thank you :)
 

Ken Puls

Administrator
Staff member
Joined
Mar 13, 2011
Messages
2,519
Reaction score
4
Points
38
Location
Nanaimo, BC, Canada
Website
www.excelguru.ca
Excel Version(s)
Excel Office 365 Insider
Sure,

Right before the line that reads "with p", you could insert the following:

Code:
With TargetCell
     .Entirecolumn.Width=16.5
     .Entirerow.Height=105
End With

Again, this is far from efficient, but it will work.

The main thrust of the efficiency point is aimed at the fact that you have 100 routines in there that essentially do the same thing. Those could be consolidated down to one routine to make things much easier to maintain.
 
Top