How to scale image to fit inside a merged cell?

[Sam Kuo]

Below is my VBA script to dynamically insert and size an image to a merged
cell.

My questions are, can I:
- scale the image to maximum inside a merged cell, while keeping its
original height to width ratio (instead of distorting the image scale to the
full merge cell size as it does now)?
- change the caption of the command button to "edit image" if an image has
been inserted, and change back to "insert image" if nothing is inserted?

Any help would be appreciated

-------------------------------------------------
Private Sub CommandButton_Click()

Dim ImageCell As Range
Set ImageCell = Sheet3.Range("B10").MergeArea

' Go to "screen dump" input merged cell (B10:AK30)
ImageCell.Select

' Open "Insert Picture" pop-up window
Application.Dialogs(xlDialogInsertPicture).Show

' Quite action if nothing is selected
On Error Resume Next

' Otherwise size the image selection to full merged cell size
With Selection
.Left = ImageCell.Left
.Top = ImageCell.Top
.Width = ImageCell.Width
.Height = ImageCell.Height
.Placement = xlMoveAndSize
End With

End Sub

 

[Tim Williams]

Dimensions of merged area: ImageCell.MergeArea.Width etc.

To scale without changing the aspect ratio, calculate the ratios of [pic
width/range width] and [pic height/range height]. Use whichever ration is
appropriate to scale *both dimensions* of the picture.


Tim

 

[Sam Kuo]

Thanks Tim. I was thinking of the same plan of attack, but don't know how to
execute in VBA. It'd be much appreciated if you (or anyone) can help...

In addition to the above questions (yes I know it's frustrating), I'd also
need to be able to delete the existing picture (if any) before inserting the
new one, so that only one image is shown at all time. Any idea how to do this
in VBA??

Many thanks!

Dimensions of merged area: ImageCell.MergeArea.Width etc.

To scale without changing the aspect ratio, calculate the ratios of [pic
width/range width] and [pic height/range height]. Use whichever ration is
appropriate to scale *both dimensions* of the picture.


Tim

Below is my VBA script to dynamically insert and size an image to a merged
cell.

My questions are, can I:
- scale the image to maximum inside a merged cell, while keeping its
original height to width ratio (instead of distorting the image scale to
the
full merge cell size as it does now)?
- change the caption of the command button to "edit image" if an image has
been inserted, and change back to "insert image" if nothing is inserted?

Any help would be appreciated

-------------------------------------------------
Private Sub CommandButton_Click()

Dim ImageCell As Range
Set ImageCell = Sheet3.Range("B10").MergeArea

' Go to "screen dump" input merged cell (B10:AK30)
ImageCell.Select

' Open "Insert Picture" pop-up window
Application.Dialogs(xlDialogInsertPicture).Show

' Quite action if nothing is selected
On Error Resume Next

' Otherwise size the image selection to full merged cell size
With Selection
.Left = ImageCell.Left
.Top = ImageCell.Top
.Width = ImageCell.Width
.Height = ImageCell.Height
.Placement = xlMoveAndSize
End With

End Sub

 

[Tim Williams]

Try this

'**************************************
Sub Tester()
Const MY_PIC As String = "MyPic"
Dim ImageCell As Range
Dim rH As Double, rW As Double
Dim fH As Double, fW As Double
Dim fMod As Double

Set ImageCell = Sheet3.Range("B10").MergeArea
rH = ImageCell.Height: rW = ImageCell.Width

' Go to "screen dump" input merged cell (B10:AK30)
ImageCell.Select

On Error Resume Next
ActiveSheet.Shapes(MY_PIC).Delete
On Error GoTo 0

' Open "Insert Picture" pop-up window
Application.Dialogs(xlDialogInsertPicture).Show
' exit if selection is not a picture
If TypeName(Selection) <> "Picture" Then Exit Sub

fH = Selection.Height / rH
fW = Selection.Width / rW
fMod = IIf(fH > fW, fH, fW)

'Size the image selection to full merged cell size
With Selection
.Left = ImageCell.Left
.Top = ImageCell.Top
.Width = .Width / fMod
.Height = .Height / fMod
.Placement = xlMoveAndSize
.Name = MY_PIC
End With

End Sub
'**************************************

Tim

Thanks Tim. I was thinking of the same plan of attack, but don't know how
to
execute in VBA. It'd be much appreciated if you (or anyone) can help...

In addition to the above questions (yes I know it's frustrating), I'd also
need to be able to delete the existing picture (if any) before inserting
the
new one, so that only one image is shown at all time. Any idea how to do
this
in VBA??

Many thanks!

Dimensions of merged area: ImageCell.MergeArea.Width etc.

To scale without changing the aspect ratio, calculate the ratios of [pic
width/range width] and [pic height/range height]. Use whichever ration
is
appropriate to scale *both dimensions* of the picture.


Tim

Below is my VBA script to dynamically insert and size an image to a
merged
cell.

My questions are, can I:
- scale the image to maximum inside a merged cell, while keeping its
original height to width ratio (instead of distorting the image scale
to
the
full merge cell size as it does now)?
- change the caption of the command button to "edit image" if an image
has
been inserted, and change back to "insert image" if nothing is
inserted?

Any help would be appreciated

-------------------------------------------------
Private Sub CommandButton_Click()

Dim ImageCell As Range
Set ImageCell = Sheet3.Range("B10").MergeArea

' Go to "screen dump" input merged cell (B10:AK30)
ImageCell.Select

' Open "Insert Picture" pop-up window
Application.Dialogs(xlDialogInsertPicture).Show

' Quite action if nothing is selected
On Error Resume Next

' Otherwise size the image selection to full merged cell size
With Selection
.Left = ImageCell.Left
.Top = ImageCell.Top
.Width = ImageCell.Width
.Height = ImageCell.Height
.Placement = xlMoveAndSize
End With

End Sub

 

[Sam Kuo]

Thanks again Tim. I really appreciate your time and effort on this issue.
It's now VERY close to what I need to achieve, with just one little
modification to make, I hope...

I can see this now deletes any existing picture regardless. How could we
modify it so the existing picture (if any) is deleted if a new picture is
inserted, OR retained otherwise if the user decides to abort the insert
picure action and keep the existing picture after opening the "Insert
Picture" pop-up window?

Many thanks!

Sam

Try this

'**************************************
Sub Tester()
Const MY_PIC As String = "MyPic"
Dim ImageCell As Range
Dim rH As Double, rW As Double
Dim fH As Double, fW As Double
Dim fMod As Double

Set ImageCell = Sheet3.Range("B10").MergeArea
rH = ImageCell.Height: rW = ImageCell.Width

' Go to "screen dump" input merged cell (B10:AK30)
ImageCell.Select

On Error Resume Next
ActiveSheet.Shapes(MY_PIC).Delete
On Error GoTo 0

' Open "Insert Picture" pop-up window
Application.Dialogs(xlDialogInsertPicture).Show
' exit if selection is not a picture
If TypeName(Selection) <> "Picture" Then Exit Sub

fH = Selection.Height / rH
fW = Selection.Width / rW
fMod = IIf(fH > fW, fH, fW)

'Size the image selection to full merged cell size
With Selection
.Left = ImageCell.Left
.Top = ImageCell.Top
.Width = .Width / fMod
.Height = .Height / fMod
.Placement = xlMoveAndSize
.Name = MY_PIC
End With

End Sub
'**************************************

Tim

Thanks Tim. I was thinking of the same plan of attack, but don't know how
to
execute in VBA. It'd be much appreciated if you (or anyone) can help...

In addition to the above questions (yes I know it's frustrating), I'd also
need to be able to delete the existing picture (if any) before inserting
the
new one, so that only one image is shown at all time. Any idea how to do
this
in VBA??

Many thanks!

Dimensions of merged area: ImageCell.MergeArea.Width etc.

To scale without changing the aspect ratio, calculate the ratios of [pic
width/range width] and [pic height/range height]. Use whichever ration
is
appropriate to scale *both dimensions* of the picture.


Tim



Below is my VBA script to dynamically insert and size an image to a
merged
cell.

My questions are, can I:
- scale the image to maximum inside a merged cell, while keeping its
original height to width ratio (instead of distorting the image scale
to
the
full merge cell size as it does now)?
- change the caption of the command button to "edit image" if an image
has
been inserted, and change back to "insert image" if nothing is
inserted?

Any help would be appreciated

-------------------------------------------------
Private Sub CommandButton_Click()

Dim ImageCell As Range
Set ImageCell = Sheet3.Range("B10").MergeArea

' Go to "screen dump" input merged cell (B10:AK30)
ImageCell.Select

' Open "Insert Picture" pop-up window
Application.Dialogs(xlDialogInsertPicture).Show

' Quite action if nothing is selected
On Error Resume Next

' Otherwise size the image selection to full merged cell size
With Selection
.Left = ImageCell.Left
.Top = ImageCell.Top
.Width = ImageCell.Width
.Height = ImageCell.Height
.Placement = xlMoveAndSize
End With

End Sub

 

[Sam Kuo]

Hi Tim. Please disregard my previous post.

It's working fine now after moving the "On Error Resume Next ... On Error
GoTo 0" to after "If TypeName(Selection)..."

Thanks lot

Sam

Try this

'**************************************
Sub Tester()
Const MY_PIC As String = "MyPic"
Dim ImageCell As Range
Dim rH As Double, rW As Double
Dim fH As Double, fW As Double
Dim fMod As Double

Set ImageCell = Sheet3.Range("B10").MergeArea
rH = ImageCell.Height: rW = ImageCell.Width

' Go to "screen dump" input merged cell (B10:AK30)
ImageCell.Select

On Error Resume Next
ActiveSheet.Shapes(MY_PIC).Delete
On Error GoTo 0

' Open "Insert Picture" pop-up window
Application.Dialogs(xlDialogInsertPicture).Show
' exit if selection is not a picture
If TypeName(Selection) <> "Picture" Then Exit Sub

fH = Selection.Height / rH
fW = Selection.Width / rW
fMod = IIf(fH > fW, fH, fW)

'Size the image selection to full merged cell size
With Selection
.Left = ImageCell.Left
.Top = ImageCell.Top
.Width = .Width / fMod
.Height = .Height / fMod
.Placement = xlMoveAndSize
.Name = MY_PIC
End With

End Sub
'**************************************

Tim

Thanks Tim. I was thinking of the same plan of attack, but don't know how
to
execute in VBA. It'd be much appreciated if you (or anyone) can help...

In addition to the above questions (yes I know it's frustrating), I'd also
need to be able to delete the existing picture (if any) before inserting
the
new one, so that only one image is shown at all time. Any idea how to do
this
in VBA??

Many thanks!

Dimensions of merged area: ImageCell.MergeArea.Width etc.

To scale without changing the aspect ratio, calculate the ratios of [pic
width/range width] and [pic height/range height]. Use whichever ration
is
appropriate to scale *both dimensions* of the picture.


Tim



Below is my VBA script to dynamically insert and size an image to a
merged
cell.

My questions are, can I:
- scale the image to maximum inside a merged cell, while keeping its
original height to width ratio (instead of distorting the image scale
to
the
full merge cell size as it does now)?
- change the caption of the command button to "edit image" if an image
has
been inserted, and change back to "insert image" if nothing is
inserted?

Any help would be appreciated

-------------------------------------------------
Private Sub CommandButton_Click()

Dim ImageCell As Range
Set ImageCell = Sheet3.Range("B10").MergeArea

' Go to "screen dump" input merged cell (B10:AK30)
ImageCell.Select

' Open "Insert Picture" pop-up window
Application.Dialogs(xlDialogInsertPicture).Show

' Quite action if nothing is selected
On Error Resume Next

' Otherwise size the image selection to full merged cell size
With Selection
.Left = ImageCell.Left
.Top = ImageCell.Top
.Width = ImageCell.Width
.Height = ImageCell.Height
.Placement = xlMoveAndSize
End With

End Sub

 

[Code Flunkie]

What would this macro be for excel 2007 it works for me in 2003 but not 2007

Chris

Hi Tim. Please disregard my previous post.

It's working fine now after moving the "On Error Resume Next ... On Error
GoTo 0" to after "If TypeName(Selection)..."

Thanks lot

Sam

Try this

'**************************************
Sub Tester()
Const MY_PIC As String = "MyPic"
Dim ImageCell As Range
Dim rH As Double, rW As Double
Dim fH As Double, fW As Double
Dim fMod As Double

Set ImageCell = Sheet3.Range("B10").MergeArea
rH = ImageCell.Height: rW = ImageCell.Width

' Go to "screen dump" input merged cell (B10:AK30)
ImageCell.Select

On Error Resume Next
ActiveSheet.Shapes(MY_PIC).Delete
On Error GoTo 0

' Open "Insert Picture" pop-up window
Application.Dialogs(xlDialogInsertPicture).Show
' exit if selection is not a picture
If TypeName(Selection) <> "Picture" Then Exit Sub

fH = Selection.Height / rH
fW = Selection.Width / rW
fMod = IIf(fH > fW, fH, fW)

'Size the image selection to full merged cell size
With Selection
.Left = ImageCell.Left
.Top = ImageCell.Top
.Width = .Width / fMod
.Height = .Height / fMod
.Placement = xlMoveAndSize
.Name = MY_PIC
End With

End Sub
'**************************************

Tim

Thanks Tim. I was thinking of the same plan of attack, but don't know how
to
execute in VBA. It'd be much appreciated if you (or anyone) can help...

In addition to the above questions (yes I know it's frustrating), I'd also
need to be able to delete the existing picture (if any) before inserting
the
new one, so that only one image is shown at all time. Any idea how to do
this
in VBA??

Many thanks!


:

Dimensions of merged area: ImageCell.MergeArea.Width etc.

To scale without changing the aspect ratio, calculate the ratios of [pic
width/range width] and [pic height/range height]. Use whichever ration
is
appropriate to scale *both dimensions* of the picture.


Tim



Below is my VBA script to dynamically insert and size an image to a
merged
cell.

My questions are, can I:
- scale the image to maximum inside a merged cell, while keeping its
original height to width ratio (instead of distorting the image scale
to
the
full merge cell size as it does now)?
- change the caption of the command button to "edit image" if an image
has
been inserted, and change back to "insert image" if nothing is
inserted?

Any help would be appreciated

-------------------------------------------------
Private Sub CommandButton_Click()

Dim ImageCell As Range
Set ImageCell = Sheet3.Range("B10").MergeArea

' Go to "screen dump" input merged cell (B10:AK30)
ImageCell.Select

' Open "Insert Picture" pop-up window
Application.Dialogs(xlDialogInsertPicture).Show

' Quite action if nothing is selected
On Error Resume Next

' Otherwise size the image selection to full merged cell size
With Selection
.Left = ImageCell.Left
.Top = ImageCell.Top
.Width = ImageCell.Width
.Height = ImageCell.Height
.Placement = xlMoveAndSize
End With

End Sub

 

[Sam Kuo]

Hi Chris

I'm using 2003 so I'm not sure what it's like with 2007.
Perhaps Tim Williams would be able to help you...

Sam

What would this macro be for excel 2007 it works for me in 2003 but not 2007

Chris

Hi Tim. Please disregard my previous post.

It's working fine now after moving the "On Error Resume Next ... On Error
GoTo 0" to after "If TypeName(Selection)..."

Thanks lot

Sam

Try this

'**************************************
Sub Tester()
Const MY_PIC As String = "MyPic"
Dim ImageCell As Range
Dim rH As Double, rW As Double
Dim fH As Double, fW As Double
Dim fMod As Double

Set ImageCell = Sheet3.Range("B10").MergeArea
rH = ImageCell.Height: rW = ImageCell.Width

' Go to "screen dump" input merged cell (B10:AK30)
ImageCell.Select

On Error Resume Next
ActiveSheet.Shapes(MY_PIC).Delete
On Error GoTo 0

' Open "Insert Picture" pop-up window
Application.Dialogs(xlDialogInsertPicture).Show
' exit if selection is not a picture
If TypeName(Selection) <> "Picture" Then Exit Sub

fH = Selection.Height / rH
fW = Selection.Width / rW
fMod = IIf(fH > fW, fH, fW)

'Size the image selection to full merged cell size
With Selection
.Left = ImageCell.Left
.Top = ImageCell.Top
.Width = .Width / fMod
.Height = .Height / fMod
.Placement = xlMoveAndSize
.Name = MY_PIC
End With

End Sub
'**************************************

Tim

Thanks Tim. I was thinking of the same plan of attack, but don't know how
to
execute in VBA. It'd be much appreciated if you (or anyone) can help...

In addition to the above questions (yes I know it's frustrating), I'd also
need to be able to delete the existing picture (if any) before inserting
the
new one, so that only one image is shown at all time. Any idea how to do
this
in VBA??

Many thanks!


:

Dimensions of merged area: ImageCell.MergeArea.Width etc.

To scale without changing the aspect ratio, calculate the ratios of [pic
width/range width] and [pic height/range height]. Use whichever ration
is
appropriate to scale *both dimensions* of the picture.


Tim



Below is my VBA script to dynamically insert and size an image to a
merged
cell.

My questions are, can I:
- scale the image to maximum inside a merged cell, while keeping its
original height to width ratio (instead of distorting the image scale
to
the
full merge cell size as it does now)?
- change the caption of the command button to "edit image" if an image
has
been inserted, and change back to "insert image" if nothing is
inserted?

Any help would be appreciated

-------------------------------------------------
Private Sub CommandButton_Click()

Dim ImageCell As Range
Set ImageCell = Sheet3.Range("B10").MergeArea

' Go to "screen dump" input merged cell (B10:AK30)
ImageCell.Select

' Open "Insert Picture" pop-up window
Application.Dialogs(xlDialogInsertPicture).Show

' Quite action if nothing is selected
On Error Resume Next

' Otherwise size the image selection to full merged cell size
With Selection
.Left = ImageCell.Left
.Top = ImageCell.Top
.Width = ImageCell.Width
.Height = ImageCell.Height
.Placement = xlMoveAndSize
End With

End Sub

 

[gary]

For some reason, excel 2007 doesn't like this line:

..Width = .Width / fMod

if you change the code as shown below with fW2 & fH2, it works in 2007

Gary

Hi Chris

I'm using 2003 so I'm not sure what it's like with 2007.
Perhaps Tim Williams would be able to help you...

Sam

What would this macro be for excel 2007 it works for me in 2003 but not 2007

Chris

Hi Tim. Please disregard my previous post.

It's working fine now after moving the "On Error Resume Next ... On Error
GoTo 0" to after "If TypeName(Selection)..."

Thanks lot

Sam


:

Try this

'**************************************
Sub Tester()
Const MY_PIC As String = "MyPic"
Dim ImageCell As Range
Dim rH As Double, rW As Double
Dim fH As Double, fW As Double
Dim fH2 As Double, fW2 As Double
Dim fMod As Double

Set ImageCell = Sheet3.Range("B10").MergeArea
rH = ImageCell.Height: rW = ImageCell.Width

' Go to "screen dump" input merged cell (B10:AK30)
ImageCell.Select

On Error Resume Next
ActiveSheet.Shapes(MY_PIC).Delete
On Error GoTo 0

' Open "Insert Picture" pop-up window
Application.Dialogs(xlDialogInsertPicture).Show
' exit if selection is not a picture
If TypeName(Selection) <> "Picture" Then Exit Sub

fH = Selection.Height / rH
fW = Selection.Width / rW
fMod = IIf(fH > fW, fH, fW)

'Size the image selection to full merged cell size
With Selection
.Left = ImageCell.Left
.Top = ImageCell.Top
fH2 = .Height
fW2 = .Width
.Width = fW2 / fMod
.Height = FH2 / fMod
.Placement = xlMoveAndSize
.Name = MY_PIC
End With

End Sub
'**************************************

Tim

Thanks Tim. I was thinking of the same plan of attack, but don't know how
to
execute in VBA. It'd be much appreciated if you (or anyone) can help...

In addition to the above questions (yes I know it's frustrating), I'd also
need to be able to delete the existing picture (if any) before inserting
the
new one, so that only one image is shown at all time. Any idea how to do
this
in VBA??

Many thanks!


:

Dimensions of merged area: ImageCell.MergeArea.Width etc.

To scale without changing the aspect ratio, calculate the ratios of [pic
width/range width] and [pic height/range height]. Use whichever ration
is
appropriate to scale *both dimensions* of the picture.


Tim



Below is my VBA script to dynamically insert and size an image to a
merged
cell.

My questions are, can I:
- scale the image to maximum inside a merged cell, while keeping its
original height to width ratio (instead of distorting the image scale
to
the
full merge cell size as it does now)?
- change the caption of the command button to "edit image" if an image
has
been inserted, and change back to "insert image" if nothing is
inserted?

Any help would be appreciated

-------------------------------------------------
Private Sub CommandButton_Click()

Dim ImageCell As Range
Set ImageCell = Sheet3.Range("B10").MergeArea

' Go to "screen dump" input merged cell (B10:AK30)
ImageCell.Select

' Open "Insert Picture" pop-up window
Application.Dialogs(xlDialogInsertPicture).Show

' Quite action if nothing is selected
On Error Resume Next

' Otherwise size the image selection to full merged cell size
With Selection
.Left = ImageCell.Left
.Top = ImageCell.Top
.Width = ImageCell.Width
.Height = ImageCell.Height
.Placement = xlMoveAndSize
End With

End Sub

 

[Code Flunkie]

Thanks Gary,

i've been trying to figure that one out for months.

works perfectly now

Chris

For some reason, excel 2007 doesn't like this line:

.Width = .Width / fMod

if you change the code as shown below with fW2 & fH2, it works in 2007

Gary

Hi Chris

I'm using 2003 so I'm not sure what it's like with 2007.
Perhaps Tim Williams would be able to help you...

Sam

What would this macro be for excel 2007 it works for me in 2003 but not 2007

Chris

:

Hi Tim. Please disregard my previous post.

It's working fine now after moving the "On Error Resume Next ... On Error
GoTo 0" to after "If TypeName(Selection)..."

Thanks lot

Sam


:

Try this

'**************************************
Sub Tester()
Const MY_PIC As String = "MyPic"
Dim ImageCell As Range
Dim rH As Double, rW As Double
Dim fH As Double, fW As Double
Dim fH2 As Double, fW2 As Double
Dim fMod As Double

Set ImageCell = Sheet3.Range("B10").MergeArea
rH = ImageCell.Height: rW = ImageCell.Width

' Go to "screen dump" input merged cell (B10:AK30)
ImageCell.Select

On Error Resume Next
ActiveSheet.Shapes(MY_PIC).Delete
On Error GoTo 0

' Open "Insert Picture" pop-up window
Application.Dialogs(xlDialogInsertPicture).Show
' exit if selection is not a picture
If TypeName(Selection) <> "Picture" Then Exit Sub

fH = Selection.Height / rH
fW = Selection.Width / rW
fMod = IIf(fH > fW, fH, fW)

'Size the image selection to full merged cell size
With Selection
.Left = ImageCell.Left
.Top = ImageCell.Top
fH2 = .Height
fW2 = .Width
.Width = fW2 / fMod
.Height = FH2 / fMod
.Placement = xlMoveAndSize
.Name = MY_PIC
End With

End Sub
'**************************************

Tim

Thanks Tim. I was thinking of the same plan of attack, but don't know how
to
execute in VBA. It'd be much appreciated if you (or anyone) can help...

In addition to the above questions (yes I know it's frustrating), I'd also
need to be able to delete the existing picture (if any) before inserting
the
new one, so that only one image is shown at all time. Any idea how to do
this
in VBA??

Many thanks!


:

Dimensions of merged area: ImageCell.MergeArea.Width etc.

To scale without changing the aspect ratio, calculate the ratios of [pic
width/range width] and [pic height/range height]. Use whichever ration
is
appropriate to scale *both dimensions* of the picture.


Tim



Below is my VBA script to dynamically insert and size an image to a
merged
cell.

My questions are, can I:
- scale the image to maximum inside a merged cell, while keeping its
original height to width ratio (instead of distorting the image scale
to
the
full merge cell size as it does now)?
- change the caption of the command button to "edit image" if an image
has
been inserted, and change back to "insert image" if nothing is
inserted?

Any help would be appreciated

-------------------------------------------------
Private Sub CommandButton_Click()

Dim ImageCell As Range
Set ImageCell = Sheet3.Range("B10").MergeArea

' Go to "screen dump" input merged cell (B10:AK30)
ImageCell.Select

' Open "Insert Picture" pop-up window
Application.Dialogs(xlDialogInsertPicture).Show

' Quite action if nothing is selected
On Error Resume Next

' Otherwise size the image selection to full merged cell size
With Selection
.Left = ImageCell.Left
.Top = ImageCell.Top
.Width = ImageCell.Width
.Height = ImageCell.Height
.Placement = xlMoveAndSize
End With

End Sub