Insert picture using Macro..
 

I have a macro that I use to insert pictures in excel but I am having
difficulty with the picture size, I would like the picture to keep the
Aspect Ratio but to have a maximum of 100 height and a maximum 100
width is this possible, any help is appreciated.
Thanks.

Insert picture using Macro..
 

You need to get the larger of the width or height variable and adjust it to 100

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
pict.width = 100
else
pict.height = 100
end if

" wrote:

I have a macro that I use to insert pictures in excel but I am having
difficulty with the picture size, I would like the picture to keep the
Aspect Ratio but to have a maximum of 100 height and a maximum 100
width is this possible, any help is appreciated.
Thanks.

Insert picture using Macro..
 

On Jun 18, 11:20*am, Joel wrote:
You need to get the larger of the width or height variable and adjust it to 100

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
* *pict.width = 100
else
* *pict.height = 100
end if



" wrote:
I have a macro that I use to insert pictures in excel but I am having
difficulty with the picture size, I would like the picture to keep the
Aspect Ratio but to have a maximum of 100 height and a maximum 100
width is this possible, any help is appreciated.
Thanks.- Hide quoted text -

- Show quoted text -

Thanks, you are great!.
Is there any way that I can center the pictures in the cell, because
when the width is than the height it ia scaling it to 100 but then
it is being placed slightly on the cell in to the left.
thanks

Insert picture using Macro..
 

On Jun 18, 2:07*pm, wrote:
On Jun 18, 11:20*am, Joel wrote:





You need to get the larger of the width or height variable and adjust it to 100

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
* *pict.width = 100
else
* *pict.height = 100
end if

" wrote:
I have a macro that I use to insert pictures in excel but I am having
difficulty with the picture size, I would like the picture to keep the
Aspect Ratio but to have a maximum of 100 height and a maximum 100
width is this possible, any help is appreciated.
Thanks.- Hide quoted text -

- Show quoted text -

Thanks, you are great!.
Is there any way that I can center the pictures in the cell, because
when the width is than the height it ia scaling it to 100 but then
it is being placed slightly on the cell in to the left.
thanks- Hide quoted text -

- Show quoted text -

Hi,
I am wondering if this will work! I tried but it seems that I am doing
something wrong can you help please.

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
pict.cropleft = 50
pict.cropright = 50
else
pict.height = 100
end if

Insert picture using Macro..
 

You need to get the height and width of the cell is is going into to center
the cell

CellHeight = range("A1").Height
CellWidth = range("A1").Width

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
pict.width = 100
else
pict.height = 100
end if
WidthBorder = CellWidth - pict.width
pict.left = Range("A1").left + WidthBorder/2

HeightBorder = CellHeight - pict.height
pict.top = Range("A1").Top + HeightBorder/2


" wrote:

On Jun 18, 2:07 pm, wrote:
On Jun 18, 11:20 am, Joel wrote:





You need to get the larger of the width or height variable and adjust it to 100

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
pict.width = 100
else
pict.height = 100
end if

" wrote:
I have a macro that I use to insert pictures in excel but I am having
difficulty with the picture size, I would like the picture to keep the
Aspect Ratio but to have a maximum of 100 height and a maximum 100
width is this possible, any help is appreciated.
Thanks.- Hide quoted text -

- Show quoted text -

Thanks, you are great!.
Is there any way that I can center the pictures in the cell, because
when the width is than the height it ia scaling it to 100 but then
it is being placed slightly on the cell in to the left.
thanks- Hide quoted text -

- Show quoted text -

Hi,
I am wondering if this will work! I tried but it seems that I am doing
something wrong can you help please.

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
pict.cropleft = 50
pict.cropright = 50
else
pict.height = 100
end if

Insert picture using Macro..
 

On Jun 19, 3:23*am, Joel wrote:
You need to get the height and width of the cell is is going into to center
the cell

CellHeight = range("A1").Height
CellWidth = range("A1").Width

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
* *pict.width = 100
else
* *pict.height = 100
end if
WidthBorder = CellWidth - pict.width
pict.left = Range("A1").left + WidthBorder/2

HeightBorder = CellHeight - pict.height
pict.top = Range("A1").Top + HeightBorder/2



" wrote:
On Jun 18, 2:07 pm, wrote:
On Jun 18, 11:20 am, Joel wrote:

You need to get the larger of the width or height variable and adjust it to 100

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
* *
else
* *pict.height = 100
end if

" wrote:
I have amacrothat I use toinsertpictures in excel but I am having
difficulty with thepicturesize, I would like thepictureto keep the
Aspect Ratio but to have a maximum of 100 height and a maximum 100
width is this possible, any help is appreciated.
Thanks.- Hide quoted text -

- Show quoted text -

Thanks, you are great!.
Is there any way that I can center the pictures in the cell, because
when the width is than the height it ia scaling it to 100 but then
it is being placed slightly on the cell in to the left.
thanks- Hide quoted text -

- Show quoted text -

Hi,
I am wondering if this will work! I tried but it seems that I am doing
something wrong can you help please.

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
* *pict.cropleft = 50
* *pict.cropright = 50
else
* *pict.height = 100
end if- Hide quoted text -

- Show quoted text -

Hi,
Is it possible to Crop the picture from left and right instead of
sizing it "pict.width = 100"
thanks.

Insert picture using Macro..
 

CellHeight = Range("A1").Height
CellWidth = Range("A1").Width

pict.LockAspectRatio = msoTrue
If pict.Width pict.Height Then
If pict.Width 100 Then
Crop = (CellWidth - pict.Width) / 2
pict.PictureFormat.CropLeft = Crop
pict.PictureFormat.CropRight = Crop
End If
Else
If pict.Height 100 Then
Crop = (CellWidth - pict.Width) / 2
pict.PictureFormat.CropTop = Crop
pict.PictureFormat.CropBottom = Crop
End If
End If
WidthBorder = CellWidth - pict.Width
pict.Left = Range("A1").Left + WidthBorder / 2

HeightBorder = CellHeight - pict.Height
pict.Top = Range("A1").Top + HeightBorder / 2


" wrote:

On Jun 19, 3:23 am, Joel wrote:
You need to get the height and width of the cell is is going into to center
the cell

CellHeight = range("A1").Height
CellWidth = range("A1").Width

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
pict.width = 100
else
pict.height = 100
end if
WidthBorder = CellWidth - pict.width
pict.left = Range("A1").left + WidthBorder/2

HeightBorder = CellHeight - pict.height
pict.top = Range("A1").Top + HeightBorder/2



" wrote:
On Jun 18, 2:07 pm, wrote:
On Jun 18, 11:20 am, Joel wrote:

You need to get the larger of the width or height variable and adjust it to 100

pict.LockAspectRatio = msoTrue
if pict.width pict.height then

else
pict.height = 100
end if

" wrote:
I have amacrothat I use toinsertpictures in excel but I am having
difficulty with thepicturesize, I would like thepictureto keep the
Aspect Ratio but to have a maximum of 100 height and a maximum 100
width is this possible, any help is appreciated.
Thanks.- Hide quoted text -

- Show quoted text -

Thanks, you are great!.
Is there any way that I can center the pictures in the cell, because
when the width is than the height it ia scaling it to 100 but then
it is being placed slightly on the cell in to the left.
thanks- Hide quoted text -

- Show quoted text -

Hi,
I am wondering if this will work! I tried but it seems that I am doing
something wrong can you help please.

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
pict.cropleft = 50
pict.cropright = 50
else
pict.height = 100
end if- Hide quoted text -

- Show quoted text -

Hi,
Is it possible to Crop the picture from left and right instead of
sizing it "pict.width = 100"
thanks.

Insert picture using Macro..
 

I made asmall eror

from
If pict.Height 100 Then
Crop = (CellWidth - pict.Width) / 2
to
If pict.Height 100 Then
Crop = (CellHeight - pict.Height) / 2

" wrote:

On Jun 19, 3:23 am, Joel wrote:
You need to get the height and width of the cell is is going into to center
the cell

CellHeight = range("A1").Height
CellWidth = range("A1").Width

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
pict.width = 100
else
pict.height = 100
end if
WidthBorder = CellWidth - pict.width
pict.left = Range("A1").left + WidthBorder/2

HeightBorder = CellHeight - pict.height
pict.top = Range("A1").Top + HeightBorder/2



" wrote:
On Jun 18, 2:07 pm, wrote:
On Jun 18, 11:20 am, Joel wrote:

You need to get the larger of the width or height variable and adjust it to 100

pict.LockAspectRatio = msoTrue
if pict.width pict.height then

else
pict.height = 100
end if

" wrote:
I have amacrothat I use toinsertpictures in excel but I am having
difficulty with thepicturesize, I would like thepictureto keep the
Aspect Ratio but to have a maximum of 100 height and a maximum 100
width is this possible, any help is appreciated.
Thanks.- Hide quoted text -

- Show quoted text -

Thanks, you are great!.
Is there any way that I can center the pictures in the cell, because
when the width is than the height it ia scaling it to 100 but then
it is being placed slightly on the cell in to the left.
thanks- Hide quoted text -

- Show quoted text -

Hi,
I am wondering if this will work! I tried but it seems that I am doing
something wrong can you help please.

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
pict.cropleft = 50
pict.cropright = 50
else
pict.height = 100
end if- Hide quoted text -

- Show quoted text -

Hi,
Is it possible to Crop the picture from left and right instead of
sizing it "pict.width = 100"
thanks.

Insert picture using Macro..
 

On Jun 19, 6:59*am, Joel wrote:
I made asmall eror

from
* *If pict.Height 100 Then
* * * *Crop = (CellWidth - pict.Width) / 2
to
* *If pict.Height 100 Then
* * * * Crop = (CellHeight - pict.Height) / 2



" wrote:
On Jun 19, 3:23 am, Joel wrote:
You need to get the height and width of the cell is is going into to center
the cell

CellHeight = range("A1").Height
CellWidth = range("A1").Width

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
* *pict.width = 100
else
* *pict.height = 100
end if
WidthBorder = CellWidth - pict.width
pict.left = Range("A1").left + WidthBorder/2

HeightBorder = CellHeight - pict.height
pict.top = Range("A1").Top + HeightBorder/2

" wrote:
On Jun 18, 2:07 pm, wrote:
On Jun 18, 11:20 am, Joel wrote:

You need to get the larger of the width or height variable and adjust it to 100

pict.LockAspectRatio = msoTrue
if pict.width pict.height then

else
* *pict.height = 100
end if

" wrote:
I have amacrothat I use toinsertpictures in excel but I am having
difficulty with thepicturesize, I would like thepictureto keep the
Aspect Ratio but to have a maximum of 100 height and a maximum 100
width is this possible, any help is appreciated.
Thanks.- Hide quoted text -

- Show quoted text -

Thanks, you are great!.
Is there any way that I can center the pictures in the cell, because
when the width is than the height it ia scaling it to 100 but then
it is being placed slightly on the cell in to the left.
thanks- Hide quoted text -

- Show quoted text -

Hi,
I am wondering if this will work! I tried but it seems that I am doing
something wrong can you help please.

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
* *pict.cropleft = 50
* *pict.cropright = 50
else
* *pict.height = 100
end if- Hide quoted text -

- Show quoted text -

Hi,
Is it possible to Crop thepicturefrom left and right instead of
sizing it "pict.width = 100"
thanks.- Hide quoted text -

- Show quoted text -

Hi,
Thanks, but it seems that I am doing something wrong. Below is the
Complete Macro that I have know can you look and see what I am doing
wrong.


Sub add_pictures()

Const PictureHeight = 120
DefaultPicture = "O:\MERCHGRP\AAB\pics\Mpics
\Picture_not_Available.jpg"

Application.ScreenUpdating = False

'delete pictures
For Each shp In ActiveSheet.Shapes
If shp.Type = msoPicture Then
shp.Delete
End If
Next shp

LastCol = Cells(4, Columns.Count).End(xlToLeft).Row
Rows(9).RowHeight = PictureHeight

For Each Cell In Range("B4:IV4")
If Cell < "" Then
Cell.Offset(-3, 0).ClearContents
PictureFound = Dir(Cell.Value)
If PictureFound < "" Then

Set pict = ActiveSheet.Pictures. _
Insert(Cell.Value)
pict.ShapeRange.LockAspectRatio = msoTrue
pict.ShapeRange.Height = PictureHeight
pictwidth = pict.Width
CellWidth = Cells(9, Cell.Column).Width
WidthBorder = CellWidth - pictwidth
pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

PictHeight = pict.Height
CellHeight = Cells(9, Cell.Column).Height
HeightBorder = CellHeight - PictHeight
pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)


If pict.Width pict.Height Then
Crop = (CellWidth - pict.Width) / 2
pict.PictureFormat.CropLeft = Crop
pict.PictureFormat.CropRight = Crop
End If

If pict.Height pict.Width Then
Crop = (CellHeight - pict.Height) / 2
pict.PictureFormat.CropTop = Crop
pict.PictureFormat.CropBottom = Crop
End If



Else
Set pict = ActiveSheet.Pictures. _
Insert(DefaultPicture)
pict.ShapeRange.LockAspectRatio = msoTrue
pict.ShapeRange.Height = PictureHeight
pictwidth = pict.Width
CellWidth = Cells(9, Cell.Column).Width
WidthBorder = CellWidth - pictwidth
pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

PictHeight = pict.Height
CellHeight = Cells(9, Cell.Column).Height
HeightBorder = CellHeight - PictHeight
pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)

End If
End If 'new line
Next Cell
Exit Sub 'new line


End Sub

Insert picture using Macro..
 

Be a little bit clear about what is not working. It looks likeyou were only
croping the pictures that were found and not the default picture. I modified
the code below to fix this problem and to make the code common between the
pictures found and not found.


Sub add_pictures()

Const PictureHeight = 120
Folder = "O:\MERCHGRP\AAB\pics\Mpics\"
FName = "Picture_not_Available.jpg"
DefaultPicture = Folder & FName

Application.ScreenUpdating = False

'delete pictures
For Each shp In ActiveSheet.Shapes
If shp.Type = msoPicture Then
shp.Delete
End If
Next shp

LastCol = Cells(4, Columns.Count).End(xlToLeft).Row
Rows(9).RowHeight = PictureHeight

For Each Cell In Range("B4:IV4")
If Cell < "" Then
Cell.Offset(-3, 0).ClearContents
PictureFound = Dir(Cell.Value)
If PictureFound < "" Then

Set pict = ActiveSheet.Pictures. _
Insert(Cell.Value)
Else
Set pict = ActiveSheet.Pictures. _
Insert(DefaultPicture)
End If
pict.ShapeRange.LockAspectRatio = msoTrue
pict.ShapeRange.Height = PictureHeight
pictwidth = pict.Width
CellWidth = Cells(9, Cell.Column).Width
WidthBorder = CellWidth - pictwidth
pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

PictHeight = pict.Height
CellHeight = Cells(9, Cell.Column).Height
HeightBorder = CellHeight - PictHeight
pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)


If pict.Width pict.Height Then
Crop = (CellWidth - pict.Width) / 2
pict.PictureFormat.CropLeft = Crop
pict.PictureFormat.CropRight = Crop
Else
Crop = (CellHeight - pict.Height) / 2
pict.PictureFormat.CropTop = Crop
pict.PictureFormat.CropBottom = Crop
End If
End If 'new line
Next Cell
Exit Sub 'new line

End Sub


" wrote:

On Jun 19, 6:59 am, Joel wrote:
I made asmall eror

from
If pict.Height 100 Then
Crop = (CellWidth - pict.Width) / 2
to
If pict.Height 100 Then
Crop = (CellHeight - pict.Height) / 2



" wrote:
On Jun 19, 3:23 am, Joel wrote:
You need to get the height and width of the cell is is going into to center
the cell

CellHeight = range("A1").Height
CellWidth = range("A1").Width

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
pict.width = 100
else
pict.height = 100
end if
WidthBorder = CellWidth - pict.width
pict.left = Range("A1").left + WidthBorder/2

HeightBorder = CellHeight - pict.height
pict.top = Range("A1").Top + HeightBorder/2

" wrote:
On Jun 18, 2:07 pm, wrote:
On Jun 18, 11:20 am, Joel wrote:

You need to get the larger of the width or height variable and adjust it to 100

pict.LockAspectRatio = msoTrue
if pict.width pict.height then

else
pict.height = 100
end if

" wrote:
I have amacrothat I use toinsertpictures in excel but I am having
difficulty with thepicturesize, I would like thepictureto keep the
Aspect Ratio but to have a maximum of 100 height and a maximum 100
width is this possible, any help is appreciated.
Thanks.- Hide quoted text -

- Show quoted text -

Thanks, you are great!.
Is there any way that I can center the pictures in the cell, because
when the width is than the height it ia scaling it to 100 but then
it is being placed slightly on the cell in to the left.
thanks- Hide quoted text -

- Show quoted text -

Hi,
I am wondering if this will work! I tried but it seems that I am doing
something wrong can you help please.

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
pict.cropleft = 50
pict.cropright = 50
else
pict.height = 100
end if- Hide quoted text -

- Show quoted text -

Hi,
Is it possible to Crop thepicturefrom left and right instead of
sizing it "pict.width = 100"
thanks.- Hide quoted text -

- Show quoted text -

Hi,
Thanks, but it seems that I am doing something wrong. Below is the
Complete Macro that I have know can you look and see what I am doing
wrong.


Sub add_pictures()

Const PictureHeight = 120
DefaultPicture = "O:\MERCHGRP\AAB\pics\Mpics
\Picture_not_Available.jpg"

Application.ScreenUpdating = False

'delete pictures
For Each shp In ActiveSheet.Shapes
If shp.Type = msoPicture Then
shp.Delete
End If
Next shp

LastCol = Cells(4, Columns.Count).End(xlToLeft).Row
Rows(9).RowHeight = PictureHeight

For Each Cell In Range("B4:IV4")
If Cell < "" Then
Cell.Offset(-3, 0).ClearContents
PictureFound = Dir(Cell.Value)
If PictureFound < "" Then

Set pict = ActiveSheet.Pictures. _
Insert(Cell.Value)
pict.ShapeRange.LockAspectRatio = msoTrue
pict.ShapeRange.Height = PictureHeight
pictwidth = pict.Width
CellWidth = Cells(9, Cell.Column).Width
WidthBorder = CellWidth - pictwidth
pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

PictHeight = pict.Height
CellHeight = Cells(9, Cell.Column).Height
HeightBorder = CellHeight - PictHeight
pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)


If pict.Width pict.Height Then
Crop = (CellWidth - pict.Width) / 2
pict.PictureFormat.CropLeft = Crop
pict.PictureFormat.CropRight = Crop
End If

If pict.Height pict.Width Then
Crop = (CellHeight - pict.Height) / 2
pict.PictureFormat.CropTop = Crop
pict.PictureFormat.CropBottom = Crop
End If



Else
Set pict = ActiveSheet.Pictures. _
Insert(DefaultPicture)
pict.ShapeRange.LockAspectRatio = msoTrue
pict.ShapeRange.Height = PictureHeight
pictwidth = pict.Width
CellWidth = Cells(9, Cell.Column).Width
WidthBorder = CellWidth - pictwidth
pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

PictHeight = pict.Height
CellHeight = Cells(9, Cell.Column).Height
HeightBorder = CellHeight - PictHeight
pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)

End If
End If 'new line
Next Cell
Exit Sub 'new line


End Sub

Insert picture using Macro..
 

On Jun 19, 9:22*am, Joel wrote:
Be a little bit clear about what is not working. *It looks likeyou were only
croping the pictures that were found and not the defaultpicture. *I modified
the code below to fix this problem and to make the code common between the
pictures found and not found.

Sub add_pictures()

Const PictureHeight = 120
Folder = "O:\MERCHGRP\AAB\pics\Mpics\"
FName = "Picture_not_Available.jpg"
DefaultPicture = Folder & FName

Application.ScreenUpdating = False

'delete pictures
For Each shp In ActiveSheet.Shapes
* *If shp.Type = msoPicture Then
* * * shp.Delete
* *End If
Next shp

LastCol = Cells(4, Columns.Count).End(xlToLeft).Row
Rows(9).RowHeight = PictureHeight

For Each Cell In Range("B4:IV4")
* *If Cell < "" Then
* * * Cell.Offset(-3, 0).ClearContents
* * * PictureFound = Dir(Cell.Value)
* * * If PictureFound < "" Then

* * * * *Set pict = ActiveSheet.Pictures. _
* * * * * *Insert(Cell.Value)
* * * *Else
* * * * * * * * Set pict = ActiveSheet.Pictures. _
* * * * * *Insert(DefaultPicture)
* * * *End If
* * * * *pict.ShapeRange.LockAspectRatio = msoTrue
* * * * *pict.ShapeRange.Height = PictureHeight
* * * * *pictwidth = pict.Width
* * * * *CellWidth = Cells(9, Cell.Column).Width
* * * * *WidthBorder = CellWidth - pictwidth
* * * * *pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

* * * * *PictHeight = pict.Height
* * * * *CellHeight = Cells(9, Cell.Column).Height
* * * * *HeightBorder = CellHeight - PictHeight
* * * * *pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)

* * * * *If pict.Width pict.Height Then
* * * * * * Crop = (CellWidth - pict.Width) / 2
* * * * * * pict.PictureFormat.CropLeft = Crop
* * * * * * pict.PictureFormat.CropRight = Crop
* * * * *Else
* * * * * * Crop = (CellHeight - pict.Height) / 2
* * * * * * pict.PictureFormat.CropTop = Crop
* * * * * * pict.PictureFormat.CropBottom = Crop
* * * * *End If
* *End If 'new line
Next Cell
Exit Sub 'new line

End Sub



" wrote:
On Jun 19, 6:59 am, Joel wrote:
I made asmall eror

from
* *If pict.Height 100 Then
* * * *Crop = (CellWidth - pict.Width) / 2
to
* *If pict.Height 100 Then
* * * * Crop = (CellHeight - pict.Height) / 2

" wrote:
On Jun 19, 3:23 am, Joel wrote:
You need to get the height and width of the cell is is going into to center
the cell

CellHeight = range("A1").Height
CellWidth = range("A1").Width

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
* *pict.width = 100
else
* *pict.height = 100
end if
WidthBorder = CellWidth - pict.width
pict.left = Range("A1").left + WidthBorder/2

HeightBorder = CellHeight - pict.height
pict.top = Range("A1").Top + HeightBorder/2

" wrote:
On Jun 18, 2:07 pm, wrote:
On Jun 18, 11:20 am, Joel wrote:

You need to get the larger of the width or height variable and adjust it to 100

pict.LockAspectRatio = msoTrue
if pict.width pict.height then

else
* *pict.height = 100
end if

" wrote:
I have amacrothat I use toinsertpictures in excel but I am having
difficulty with thepicturesize, I would like thepictureto keep the
Aspect Ratio but to have a maximum of 100 height and a maximum 100
width is this possible, any help is appreciated.
Thanks.- Hide quoted text -

- Show quoted text -

Thanks, you are great!.
Is there any way that I can center the pictures in the cell, because
when the width is than the height it ia scaling it to 100 but then
it is being placed slightly on the cell in to the left.
thanks- Hide quoted text -

- Show quoted text -

Hi,
I am wondering if this will work! I tried but it seems that I am doing
something wrong can you help please.

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
* *pict.cropleft = 50
* *pict.cropright = 50
else
* *pict.height = 100
end if- Hide quoted text -

- Show quoted text -

Hi,
Is it possible to Crop thepicturefrom left and right instead of
sizing it "pict.width = 100"
thanks.- Hide quoted text -

- Show quoted text -

Hi,
Thanks, but it seems that I am doing something wrong. Below is the
CompleteMacrothat I have know can you look and see what I am doing
wrong.

Sub add_pictures()

Const PictureHeight = 120
DefaultPicture = "O:\MERCHGRP\AAB\pics\Mpics
\Picture_not_Available.jpg"

Application.ScreenUpdating = False

'delete pictures
For Each shp In ActiveSheet.Shapes
* *If shp.Type = msoPicture Then
* * * shp.Delete
* *End If
Next shp

LastCol = Cells(4, Columns.Count).End(xlToLeft).Row
Rows(9).RowHeight = PictureHeight

For Each Cell In Range("B4:IV4")
* *If Cell < "" Then
* * * Cell.Offset(-3, 0).ClearContents
* * * PictureFound = Dir(Cell.Value)
* * * If PictureFound < "" Then

* * * * *Set pict = ActiveSheet.Pictures. _
* * * * * *Insert(Cell.Value)
* * * * *pict.ShapeRange.LockAspectRatio = msoTrue
* * * * *pict.ShapeRange.Height = PictureHeight
* * * * *pictwidth = pict.Width
* * * * *CellWidth = Cells(9, Cell.Column).Width
* * * * *WidthBorder = CellWidth - pictwidth
* * * * *pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

* * * * *PictHeight = pict.Height
* * * * *CellHeight = Cells(9, Cell.Column).Height
* * * * *HeightBorder = CellHeight - PictHeight
* * * * *pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)

If pict.Width pict.Height Then
* * * *Crop = (CellWidth - pict.Width) / 2
* * * *pict.PictureFormat.CropLeft = Crop
* * * *pict.PictureFormat.CropRight = Crop
* *End If

* *If pict.Height pict.Width Then
* * * *Crop = (CellHeight - pict.Height) / 2
* * * *pict.PictureFormat.CropTop = Crop
* * * *pict.PictureFormat.CropBottom = Crop
* *End If

* * * Else
* * * * *Set pict = ActiveSheet.Pictures. _
* * * * * *Insert(DefaultPicture)
* * * * *pict.ShapeRange.LockAspectRatio = msoTrue
* * * * *pict.ShapeRange.Height = PictureHeight
* * * * *pictwidth = pict.Width
* * * * *CellWidth = Cells(9, Cell.Column).Width
* * * * *WidthBorder = CellWidth - pictwidth
* * * * *pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

* * * * *PictHeight = pict.Height
* * * * *CellHeight = Cells(9, Cell.Column).Height
* * * * *HeightBorder = CellHeight - PictHeight
* * * * *pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)

* *End If
* *End If 'new line
Next Cell
Exit Sub 'new line

End Sub- Hide quoted text -

- Show quoted text -

Hi,
There is no need to crop the Default picture because it is a standerd
size made to fit, the other pictures are the one that when they were
created it was created all different sizes and propotions.
Thanks.

Insert picture using Macro..
 

On Jun 19, 9:22*am, Joel wrote:
Be a little bit clear about what is not working. *It looks likeyou were only
croping the pictures that were found and not the defaultpicture. *I modified
the code below to fix this problem and to make the code common between the
pictures found and not found.

Sub add_pictures()

Const PictureHeight = 120
Folder = "O:\MERCHGRP\AAB\pics\Mpics\"
FName = "Picture_not_Available.jpg"
DefaultPicture = Folder & FName

Application.ScreenUpdating = False

'delete pictures
For Each shp In ActiveSheet.Shapes
* *If shp.Type = msoPicture Then
* * * shp.Delete
* *End If
Next shp

LastCol = Cells(4, Columns.Count).End(xlToLeft).Row
Rows(9).RowHeight = PictureHeight

For Each Cell In Range("B4:IV4")
* *If Cell < "" Then
* * * Cell.Offset(-3, 0).ClearContents
* * * PictureFound = Dir(Cell.Value)
* * * If PictureFound < "" Then

* * * * *Set pict = ActiveSheet.Pictures. _
* * * * * *Insert(Cell.Value)
* * * *Else
* * * * * * * * Set pict = ActiveSheet.Pictures. _
* * * * * *Insert(DefaultPicture)
* * * *End If
* * * * *pict.ShapeRange.LockAspectRatio = msoTrue
* * * * *pict.ShapeRange.Height = PictureHeight
* * * * *pictwidth = pict.Width
* * * * *CellWidth = Cells(9, Cell.Column).Width
* * * * *WidthBorder = CellWidth - pictwidth
* * * * *pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

* * * * *PictHeight = pict.Height
* * * * *CellHeight = Cells(9, Cell.Column).Height
* * * * *HeightBorder = CellHeight - PictHeight
* * * * *pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)

* * * * *If pict.Width pict.Height Then
* * * * * * Crop = (CellWidth - pict.Width) / 2
* * * * * * pict.PictureFormat.CropLeft = Crop
* * * * * * pict.PictureFormat.CropRight = Crop
* * * * *Else
* * * * * * Crop = (CellHeight - pict.Height) / 2
* * * * * * pict.PictureFormat.CropTop = Crop
* * * * * * pict.PictureFormat.CropBottom = Crop
* * * * *End If
* *End If 'new line
Next Cell
Exit Sub 'new line

End Sub



" wrote:
On Jun 19, 6:59 am, Joel wrote:
I made asmall eror

from
* *If pict.Height 100 Then
* * * *Crop = (CellWidth - pict.Width) / 2
to
* *If pict.Height 100 Then
* * * * Crop = (CellHeight - pict.Height) / 2

" wrote:
On Jun 19, 3:23 am, Joel wrote:
You need to get the height and width of the cell is is going into to center
the cell

CellHeight = range("A1").Height
CellWidth = range("A1").Width

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
* *pict.width = 100
else
* *pict.height = 100
end if
WidthBorder = CellWidth - pict.width
pict.left = Range("A1").left + WidthBorder/2

HeightBorder = CellHeight - pict.height
pict.top = Range("A1").Top + HeightBorder/2

" wrote:
On Jun 18, 2:07 pm, wrote:
On Jun 18, 11:20 am, Joel wrote:

You need to get the larger of the width or height variable and adjust it to 100

pict.LockAspectRatio = msoTrue
if pict.width pict.height then

else
* *pict.height = 100
end if

" wrote:
I have amacrothat I use toinsertpictures in excel but I am having
difficulty with thepicturesize, I would like thepictureto keep the
Aspect Ratio but to have a maximum of 100 height and a maximum 100
width is this possible, any help is appreciated.
Thanks.- Hide quoted text -

- Show quoted text -

Thanks, you are great!.
Is there any way that I can center the pictures in the cell, because
when the width is than the height it ia scaling it to 100 but then
it is being placed slightly on the cell in to the left.
thanks- Hide quoted text -

- Show quoted text -

Hi,
I am wondering if this will work! I tried but it seems that I am doing
something wrong can you help please.

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
* *pict.cropleft = 50
* *pict.cropright = 50
else
* *pict.height = 100
end if- Hide quoted text -

- Show quoted text -

Hi,
Is it possible to Crop thepicturefrom left and right instead of
sizing it "pict.width = 100"
thanks.- Hide quoted text -

- Show quoted text -

Hi,
Thanks, but it seems that I am doing something wrong. Below is the
CompleteMacrothat I have know can you look and see what I am doing
wrong.

Sub add_pictures()

Const PictureHeight = 120
DefaultPicture = "O:\MERCHGRP\AAB\pics\Mpics
\Picture_not_Available.jpg"

Application.ScreenUpdating = False

'delete pictures
For Each shp In ActiveSheet.Shapes
* *If shp.Type = msoPicture Then
* * * shp.Delete
* *End If
Next shp

LastCol = Cells(4, Columns.Count).End(xlToLeft).Row
Rows(9).RowHeight = PictureHeight

For Each Cell In Range("B4:IV4")
* *If Cell < "" Then
* * * Cell.Offset(-3, 0).ClearContents
* * * PictureFound = Dir(Cell.Value)
* * * If PictureFound < "" Then

* * * * *Set pict = ActiveSheet.Pictures. _
* * * * * *Insert(Cell.Value)
* * * * *pict.ShapeRange.LockAspectRatio = msoTrue
* * * * *pict.ShapeRange.Height = PictureHeight
* * * * *pictwidth = pict.Width
* * * * *CellWidth = Cells(9, Cell.Column).Width
* * * * *WidthBorder = CellWidth - pictwidth
* * * * *pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

* * * * *PictHeight = pict.Height
* * * * *CellHeight = Cells(9, Cell.Column).Height
* * * * *HeightBorder = CellHeight - PictHeight
* * * * *pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)

If pict.Width pict.Height Then
* * * *Crop = (CellWidth - pict.Width) / 2
* * * *pict.PictureFormat.CropLeft = Crop
* * * *pict.PictureFormat.CropRight = Crop
* *End If

* *If pict.Height pict.Width Then
* * * *Crop = (CellHeight - pict.Height) / 2
* * * *pict.PictureFormat.CropTop = Crop
* * * *pict.PictureFormat.CropBottom = Crop
* *End If

* * * Else
* * * * *Set pict = ActiveSheet.Pictures. _
* * * * * *Insert(DefaultPicture)
* * * * *pict.ShapeRange.LockAspectRatio = msoTrue
* * * * *pict.ShapeRange.Height = PictureHeight
* * * * *pictwidth = pict.Width
* * * * *CellWidth = Cells(9, Cell.Column).Width
* * * * *WidthBorder = CellWidth - pictwidth
* * * * *pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

* * * * *PictHeight = pict.Height
* * * * *CellHeight = Cells(9, Cell.Column).Height
* * * * *HeightBorder = CellHeight - PictHeight
* * * * *pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)

* *End If
* *End If 'new line
Next Cell
Exit Sub 'new line

End Sub- Hide quoted text -

- Show quoted text -

Hi,
I just tried the last one you sent and it is giving an error at
"pict.PictureFormat.CropTop = Crop"
Thanks.

Insert picture using Macro..
 

shaperange was missing

Sub add_pictures()

Const PictureHeight = 120
Folder = "O:\MERCHGRP\AAB\pics\Mpics\"
FName = "Picture_not_Available.jpg"
DefaultPicture = Folder & FName

Application.ScreenUpdating = False

'delete pictures
For Each shp In ActiveSheet.Shapes
If shp.Type = msoPicture Then
shp.Delete
End If
Next shp

LastCol = Cells(4, Columns.Count).End(xlToLeft).Row
Rows(9).RowHeight = PictureHeight

For Each Cell In Range("B4:IV4")
If Cell < "" Then
Cell.Offset(-3, 0).ClearContents
PictureFound = Dir(Cell.Value)
If PictureFound < "" Then

Set pict = ActiveSheet.Pictures. _
Insert(Cell.Value)
Else
Set pict = ActiveSheet.Pictures. _
Insert(DefaultPicture)
End If
pict.ShapeRange.LockAspectRatio = msoTrue
'pict.ShapeRange.Height = PictureHeight <=deleted
pictwidth = pict.Width
CellWidth = Cells(9, Cell.Column).Width
WidthBorder = CellWidth - pictwidth
pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

PictHeight = pict.Height
CellHeight = Cells(9, Cell.Column).Height
HeightBorder = CellHeight - PictHeight
pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)


If pict.Width pict.Height Then
Crop = (CellWidth - pict.Width) / 2
pict.ShapeRange.PictureFormat.CropLeft = Crop
pict.ShapeRange.PictureFormat.CropRight = Crop
Else
Crop = (CellHeight - pict.Height) / 2
pict.ShapeRange.PictureFormat.CropTop = Crop
pict.ShapeRange.PictureFormat.CropBottom = Crop
End If
End If 'new line
Next Cell
Exit Sub 'new line

End Sub



" wrote:

On Jun 19, 9:22 am, Joel wrote:
Be a little bit clear about what is not working. It looks likeyou were only
croping the pictures that were found and not the defaultpicture. I modified
the code below to fix this problem and to make the code common between the
pictures found and not found.

Sub add_pictures()

Const PictureHeight = 120
Folder = "O:\MERCHGRP\AAB\pics\Mpics\"
FName = "Picture_not_Available.jpg"
DefaultPicture = Folder & FName

Application.ScreenUpdating = False

'delete pictures
For Each shp In ActiveSheet.Shapes
If shp.Type = msoPicture Then
shp.Delete
End If
Next shp

LastCol = Cells(4, Columns.Count).End(xlToLeft).Row
Rows(9).RowHeight = PictureHeight

For Each Cell In Range("B4:IV4")
If Cell < "" Then
Cell.Offset(-3, 0).ClearContents
PictureFound = Dir(Cell.Value)
If PictureFound < "" Then

Set pict = ActiveSheet.Pictures. _
Insert(Cell.Value)
Else
Set pict = ActiveSheet.Pictures. _
Insert(DefaultPicture)
End If
pict.ShapeRange.LockAspectRatio = msoTrue
pict.ShapeRange.Height = PictureHeight
pictwidth = pict.Width
CellWidth = Cells(9, Cell.Column).Width
WidthBorder = CellWidth - pictwidth
pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

PictHeight = pict.Height
CellHeight = Cells(9, Cell.Column).Height
HeightBorder = CellHeight - PictHeight
pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)

If pict.Width pict.Height Then
Crop = (CellWidth - pict.Width) / 2
pict.PictureFormat.CropLeft = Crop
pict.PictureFormat.CropRight = Crop
Else
Crop = (CellHeight - pict.Height) / 2
pict.PictureFormat.CropTop = Crop
pict.PictureFormat.CropBottom = Crop
End If
End If 'new line
Next Cell
Exit Sub 'new line

End Sub



" wrote:
On Jun 19, 6:59 am, Joel wrote:
I made asmall eror

from
If pict.Height 100 Then
Crop = (CellWidth - pict.Width) / 2
to
If pict.Height 100 Then
Crop = (CellHeight - pict.Height) / 2

" wrote:
On Jun 19, 3:23 am, Joel wrote:
You need to get the height and width of the cell is is going into to center
the cell

CellHeight = range("A1").Height
CellWidth = range("A1").Width

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
pict.width = 100
else
pict.height = 100
end if
WidthBorder = CellWidth - pict.width
pict.left = Range("A1").left + WidthBorder/2

HeightBorder = CellHeight - pict.height
pict.top = Range("A1").Top + HeightBorder/2

" wrote:
On Jun 18, 2:07 pm, wrote:
On Jun 18, 11:20 am, Joel wrote:

You need to get the larger of the width or height variable and adjust it to 100

pict.LockAspectRatio = msoTrue
if pict.width pict.height then

else
pict.height = 100
end if

" wrote:
I have amacrothat I use toinsertpictures in excel but I am having
difficulty with thepicturesize, I would like thepictureto keep the
Aspect Ratio but to have a maximum of 100 height and a maximum 100
width is this possible, any help is appreciated.
Thanks.- Hide quoted text -

- Show quoted text -

Thanks, you are great!.
Is there any way that I can center the pictures in the cell, because
when the width is than the height it ia scaling it to 100 but then
it is being placed slightly on the cell in to the left.
thanks- Hide quoted text -

- Show quoted text -

Hi,
I am wondering if this will work! I tried but it seems that I am doing
something wrong can you help please.

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
pict.cropleft = 50
pict.cropright = 50
else
pict.height = 100
end if- Hide quoted text -

- Show quoted text -

Hi,
Is it possible to Crop thepicturefrom left and right instead of
sizing it "pict.width = 100"
thanks.- Hide quoted text -

- Show quoted text -

Hi,
Thanks, but it seems that I am doing something wrong. Below is the
CompleteMacrothat I have know can you look and see what I am doing
wrong.

Sub add_pictures()

Const PictureHeight = 120
DefaultPicture = "O:\MERCHGRP\AAB\pics\Mpics
\Picture_not_Available.jpg"

Application.ScreenUpdating = False

'delete pictures
For Each shp In ActiveSheet.Shapes
If shp.Type = msoPicture Then
shp.Delete
End If
Next shp

LastCol = Cells(4, Columns.Count).End(xlToLeft).Row
Rows(9).RowHeight = PictureHeight

For Each Cell In Range("B4:IV4")
If Cell < "" Then
Cell.Offset(-3, 0).ClearContents
PictureFound = Dir(Cell.Value)
If PictureFound < "" Then

Set pict = ActiveSheet.Pictures. _
Insert(Cell.Value)
pict.ShapeRange.LockAspectRatio = msoTrue
pict.ShapeRange.Height = PictureHeight
pictwidth = pict.Width
CellWidth = Cells(9, Cell.Column).Width
WidthBorder = CellWidth - pictwidth
pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

PictHeight = pict.Height
CellHeight = Cells(9, Cell.Column).Height
HeightBorder = CellHeight - PictHeight
pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)

If pict.Width pict.Height Then
Crop = (CellWidth - pict.Width) / 2
pict.PictureFormat.CropLeft = Crop
pict.PictureFormat.CropRight = Crop
End If

If pict.Height pict.Width Then
Crop = (CellHeight - pict.Height) / 2
pict.PictureFormat.CropTop = Crop
pict.PictureFormat.CropBottom = Crop
End If

Else
Set pict = ActiveSheet.Pictures. _
Insert(DefaultPicture)
pict.ShapeRange.LockAspectRatio = msoTrue
pict.ShapeRange.Height = PictureHeight
pictwidth = pict.Width
CellWidth = Cells(9, Cell.Column).Width
WidthBorder = CellWidth - pictwidth
pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

PictHeight = pict.Height
CellHeight = Cells(9, Cell.Column).Height
HeightBorder = CellHeight - PictHeight
pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)

End If
End If 'new line
Next Cell
Exit Sub 'new line

End Sub- Hide quoted text -

- Show quoted text -

Hi,
I just tried the last one you sent and it is giving an error at
"pict.PictureFormat.CropTop = Crop"
Thanks.

Insert picture using Macro..
 

On Jun 19, 10:17*am, Joel wrote:
shaperange was missing

Sub add_pictures()

Const PictureHeight = 120
Folder = "O:\MERCHGRP\AAB\pics\Mpics\"
FName = "Picture_not_Available.jpg"
DefaultPicture = Folder & FName

Application.ScreenUpdating = False

'delete pictures
For Each shp In ActiveSheet.Shapes
* *If shp.Type = msoPicture Then
* * * shp.Delete
* *End If
Next shp

LastCol = Cells(4, Columns.Count).End(xlToLeft).Row
Rows(9).RowHeight = PictureHeight

For Each Cell In Range("B4:IV4")
* *If Cell < "" Then
* * * Cell.Offset(-3, 0).ClearContents
* * * PictureFound = Dir(Cell.Value)
* * * If PictureFound < "" Then

* * * * *Set pict = ActiveSheet.Pictures. _
* * * * * *Insert(Cell.Value)
* * * *Else
* * * * * * * * Set pict = ActiveSheet.Pictures. _
* * * * * *Insert(DefaultPicture)
* * * *End If
* * * * *pict.ShapeRange.LockAspectRatio = msoTrue
* * * * *'pict.ShapeRange.Height = PictureHeight * <=deleted
* * * * *pictwidth = pict.Width
* * * * *CellWidth = Cells(9, Cell.Column).Width
* * * * *WidthBorder = CellWidth - pictwidth
* * * * *pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

* * * * *PictHeight = pict.Height
* * * * *CellHeight = Cells(9, Cell.Column).Height
* * * * *HeightBorder = CellHeight - PictHeight
* * * * *pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)

* * * * *If pict.Width pict.Height Then
* * * * * * Crop = (CellWidth - pict.Width) / 2
* * * * * * pict.ShapeRange.PictureFormat.CropLeft = Crop
* * * * * * pict.ShapeRange.PictureFormat.CropRight = Crop
* * * * *Else
* * * * * * Crop = (CellHeight - pict.Height) / 2
* * * * * * pict.ShapeRange.PictureFormat.CropTop = Crop
* * * * * * pict.ShapeRange.PictureFormat.CropBottom = Crop
* * * * *End If
* *End If 'new line
Next Cell
Exit Sub 'new line

End Sub



" wrote:
On Jun 19, 9:22 am, Joel wrote:
Be a little bit clear about what is not working. *It looks likeyou were only
croping the pictures that were found and not the defaultpicture. *I modified
the code below to fix this problem and to make the code common between the
pictures found and not found.

Sub add_pictures()

Const PictureHeight = 120
Folder = "O:\MERCHGRP\AAB\pics\Mpics\"
FName = "Picture_not_Available.jpg"
DefaultPicture = Folder & FName

Application.ScreenUpdating = False

'delete pictures
For Each shp In ActiveSheet.Shapes
* *If shp.Type = msoPicture Then
* * * shp.Delete
* *End If
Next shp

LastCol = Cells(4, Columns.Count).End(xlToLeft).Row
Rows(9).RowHeight = PictureHeight

For Each Cell In Range("B4:IV4")
* *If Cell < "" Then
* * * Cell.Offset(-3, 0).ClearContents
* * * PictureFound = Dir(Cell.Value)
* * * If PictureFound < "" Then

* * * * *Set pict = ActiveSheet.Pictures. _
* * * * * *Insert(Cell.Value)
* * * *Else
* * * * * * * * Set pict = ActiveSheet.Pictures. _
* * * * * *Insert(DefaultPicture)
* * * *End If
* * * * *pict.ShapeRange.LockAspectRatio = msoTrue
* * * * *pict.ShapeRange.Height = PictureHeight
* * * * *pictwidth = pict.Width
* * * * *CellWidth = Cells(9, Cell.Column).Width
* * * * *WidthBorder = CellWidth - pictwidth
* * * * *pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

* * * * *PictHeight = pict.Height
* * * * *CellHeight = Cells(9, Cell.Column).Height
* * * * *HeightBorder = CellHeight - PictHeight
* * * * *pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)

* * * * *If pict.Width pict.Height Then
* * * * * * Crop = (CellWidth - pict.Width) / 2
* * * * * * pict.PictureFormat.CropLeft = Crop
* * * * * * pict.PictureFormat.CropRight = Crop
* * * * *Else
* * * * * * Crop = (CellHeight - pict.Height) / 2
* * * * * * pict.PictureFormat.CropTop = Crop
* * * * * * pict.PictureFormat.CropBottom = Crop
* * * * *End If
* *End If 'new line
Next Cell
Exit Sub 'new line

End Sub

" wrote:
On Jun 19, 6:59 am, Joel wrote:
I made asmall eror

from
* *If pict.Height 100 Then
* * * *Crop = (CellWidth - pict.Width) / 2
to
* *If pict.Height 100 Then
* * * * Crop = (CellHeight - pict.Height) / 2

" wrote:
On Jun 19, 3:23 am, Joel wrote:
You need to get the height and width of the cell is is going into to center
the cell

CellHeight = range("A1").Height
CellWidth = range("A1").Width

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
* *pict.width = 100
else
* *pict.height = 100
end if
WidthBorder = CellWidth - pict.width
pict.left = Range("A1").left + WidthBorder/2

HeightBorder = CellHeight - pict.height
pict.top = Range("A1").Top + HeightBorder/2

" wrote:
On Jun 18, 2:07 pm, wrote:
On Jun 18, 11:20 am, Joel wrote:

You need to get the larger of the width or height variable and adjust it to 100

pict.LockAspectRatio = msoTrue
if pict.width pict.height then

else
* *pict.height = 100
end if

" wrote:
I have amacrothat I use toinsertpictures in excel but I am having
difficulty with thepicturesize, I would like thepictureto keep the
Aspect Ratio but to have a maximum of 100 height and a maximum 100
width is this possible, any help is appreciated.
Thanks.- Hide quoted text -

- Show quoted text -

Thanks, you are great!.
Is there any way that I can center the pictures in the cell, because
when the width is than the height it ia scaling it to 100 but then
it is being placed slightly on the cell in to the left.
thanks- Hide quoted text -

- Show quoted text -

Hi,
I am wondering if this will work! I tried but it seems that I am doing
something wrong can you help please.

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
* *pict.cropleft = 50
* *pict.cropright = 50
else
* *pict.height = 100
end if- Hide quoted text -

- Show quoted text -

Hi,
Is it possible to Crop thepicturefrom left and right instead of
sizing it "pict.width = 100"
thanks.- Hide quoted text -

- Show quoted text -

Hi,
Thanks, but it seems that I am doing something wrong. Below is the
CompleteMacrothat I have know can you look and see what I am doing
wrong.

Sub add_pictures()

Const PictureHeight = 120
DefaultPicture = "O:\MERCHGRP\AAB\pics\Mpics
\Picture_not_Available.jpg"

Application.ScreenUpdating = False

'delete pictures
For Each shp In ActiveSheet.Shapes
* *If shp.Type = msoPicture Then
* * * shp.Delete
* *End If
Next shp

LastCol = Cells(4, Columns.Count).End(xlToLeft).Row
Rows(9).RowHeight = PictureHeight

For Each Cell In Range("B4:IV4")
* *If Cell < "" Then
* * * Cell.Offset(-3, 0).ClearContents
* * * PictureFound = Dir(Cell.Value)
* * * If PictureFound < "" Then

* * * * *Set pict = ActiveSheet.Pictures. _
* * * * * *Insert(Cell.Value)
* * * * *pict.ShapeRange.LockAspectRatio = msoTrue
* * * * *pict.ShapeRange.Height = PictureHeight
* * * * *pictwidth = pict.Width
* * * * *CellWidth = Cells(9, Cell.Column).Width
* * * * *WidthBorder = CellWidth - pictwidth
* * * * *pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

* * * * *PictHeight = pict.Height
* * * * *CellHeight = Cells(9, Cell.Column).Height
* * * * *HeightBorder = CellHeight - PictHeight
* * * * *pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)

If pict.Width pict.Height Then
* * * *Crop = (CellWidth - pict.Width) / 2
* * * *pict.PictureFormat.CropLeft = Crop
* * * *pict.PictureFormat.CropRight = Crop
* *End If

* *If pict.Height pict.Width Then
* * * *Crop = (CellHeight - pict.Height) / 2
* * * *pict.PictureFormat.CropTop = Crop
* * * *pict.PictureFormat.CropBottom = Crop
* *End If

* * * Else
* * * * *Set pict = ActiveSheet.Pictures. _
* * * * * *Insert(DefaultPicture)
* * * * *pict.ShapeRange.LockAspectRatio = msoTrue
* * * * *pict.ShapeRange.Height = PictureHeight
* * * * *pictwidth = pict.Width
* * * * *CellWidth = Cells(9, Cell.Column).Width
* * * * *WidthBorder = CellWidth - pictwidth
* * * * *pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

* * * * *PictHeight = pict.Height
* * * * *CellHeight = Cells(9, Cell.Column).Height
* * * * *HeightBorder = CellHeight - PictHeight
* * * * *pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)

* *End If
* *End If 'new line
Next Cell
Exit Sub 'new line

End Sub- Hide quoted text -

- Show quoted text -

Hi,
*I just tried the last one you sent and it is giving an error at
"pict.PictureFormat.CropTop = Crop"
Thanks.- Hide quoted text -

- Show quoted text -


Hi,
Thanks, How would I crop the Width more?

Insert picture using Macro..
 

On Jun 19, 10:17*am, Joel wrote:
shaperange was missing

Sub add_pictures()

Const PictureHeight = 120
Folder = "O:\MERCHGRP\AAB\pics\Mpics\"
FName = "Picture_not_Available.jpg"
DefaultPicture = Folder & FName

Application.ScreenUpdating = False

'delete pictures
For Each shp In ActiveSheet.Shapes
* *If shp.Type = msoPicture Then
* * * shp.Delete
* *End If
Next shp

LastCol = Cells(4, Columns.Count).End(xlToLeft).Row
Rows(9).RowHeight = PictureHeight

For Each Cell In Range("B4:IV4")
* *If Cell < "" Then
* * * Cell.Offset(-3, 0).ClearContents
* * * PictureFound = Dir(Cell.Value)
* * * If PictureFound < "" Then

* * * * *Set pict = ActiveSheet.Pictures. _
* * * * * *Insert(Cell.Value)
* * * *Else
* * * * * * * * Set pict = ActiveSheet.Pictures. _
* * * * * *Insert(DefaultPicture)
* * * *End If
* * * * *pict.ShapeRange.LockAspectRatio = msoTrue
* * * * *'pict.ShapeRange.Height = PictureHeight * <=deleted
* * * * *pictwidth = pict.Width
* * * * *CellWidth = Cells(9, Cell.Column).Width
* * * * *WidthBorder = CellWidth - pictwidth
* * * * *pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

* * * * *PictHeight = pict.Height
* * * * *CellHeight = Cells(9, Cell.Column).Height
* * * * *HeightBorder = CellHeight - PictHeight
* * * * *pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)

* * * * *If pict.Width pict.Height Then
* * * * * * Crop = (CellWidth - pict.Width) / 2
* * * * * * pict.ShapeRange.PictureFormat.CropLeft = Crop
* * * * * * pict.ShapeRange.PictureFormat.CropRight = Crop
* * * * *Else
* * * * * * Crop = (CellHeight - pict.Height) / 2
* * * * * * pict.ShapeRange.PictureFormat.CropTop = Crop
* * * * * * pict.ShapeRange.PictureFormat.CropBottom = Crop
* * * * *End If
* *End If 'new line
Next Cell
Exit Sub 'new line

End Sub



" wrote:
On Jun 19, 9:22 am, Joel wrote:
Be a little bit clear about what is not working. *It looks likeyou were only
croping the pictures that were found and not the defaultpicture. *I modified
the code below to fix this problem and to make the code common between the
pictures found and not found.

Sub add_pictures()

Const PictureHeight = 120
Folder = "O:\MERCHGRP\AAB\pics\Mpics\"
FName = "Picture_not_Available.jpg"
DefaultPicture = Folder & FName

Application.ScreenUpdating = False

'delete pictures
For Each shp In ActiveSheet.Shapes
* *If shp.Type = msoPicture Then
* * * shp.Delete
* *End If
Next shp

LastCol = Cells(4, Columns.Count).End(xlToLeft).Row
Rows(9).RowHeight = PictureHeight

For Each Cell In Range("B4:IV4")
* *If Cell < "" Then
* * * Cell.Offset(-3, 0).ClearContents
* * * PictureFound = Dir(Cell.Value)
* * * If PictureFound < "" Then

* * * * *Set pict = ActiveSheet.Pictures. _
* * * * * *Insert(Cell.Value)
* * * *Else
* * * * * * * * Set pict = ActiveSheet.Pictures. _
* * * * * *Insert(DefaultPicture)
* * * *End If
* * * * *pict.ShapeRange.LockAspectRatio = msoTrue
* * * * *pict.ShapeRange.Height = PictureHeight
* * * * *pictwidth = pict.Width
* * * * *CellWidth = Cells(9, Cell.Column).Width
* * * * *WidthBorder = CellWidth - pictwidth
* * * * *pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

* * * * *PictHeight = pict.Height
* * * * *CellHeight = Cells(9, Cell.Column).Height
* * * * *HeightBorder = CellHeight - PictHeight
* * * * *pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)

* * * * *If pict.Width pict.Height Then
* * * * * * Crop = (CellWidth - pict.Width) / 2
* * * * * * pict.PictureFormat.CropLeft = Crop
* * * * * * pict.PictureFormat.CropRight = Crop
* * * * *Else
* * * * * * Crop = (CellHeight - pict.Height) / 2
* * * * * * pict.PictureFormat.CropTop = Crop
* * * * * * pict.PictureFormat.CropBottom = Crop
* * * * *End If
* *End If 'new line
Next Cell
Exit Sub 'new line

End Sub

" wrote:
On Jun 19, 6:59 am, Joel wrote:
I made asmall eror

from
* *If pict.Height 100 Then
* * * *Crop = (CellWidth - pict.Width) / 2
to
* *If pict.Height 100 Then
* * * * Crop = (CellHeight - pict.Height) / 2

" wrote:
On Jun 19, 3:23 am, Joel wrote:
You need to get the height and width of the cell is is going into to center
the cell

CellHeight = range("A1").Height
CellWidth = range("A1").Width

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
* *pict.width = 100
else
* *pict.height = 100
end if
WidthBorder = CellWidth - pict.width
pict.left = Range("A1").left + WidthBorder/2

HeightBorder = CellHeight - pict.height
pict.top = Range("A1").Top + HeightBorder/2

" wrote:
On Jun 18, 2:07 pm, wrote:
On Jun 18, 11:20 am, Joel wrote:

You need to get the larger of the width or height variable and adjust it to 100

pict.LockAspectRatio = msoTrue
if pict.width pict.height then

else
* *pict.height = 100
end if

" wrote:
I have amacrothat I use toinsertpictures in excel but I am having
difficulty with thepicturesize, I would like thepictureto keep the
Aspect Ratio but to have a maximum of 100 height and a maximum 100
width is this possible, any help is appreciated.
Thanks.- Hide quoted text -

- Show quoted text -

Thanks, you are great!.
Is there any way that I can center the pictures in the cell, because
when the width is than the height it ia scaling it to 100 but then
it is being placed slightly on the cell in to the left.
thanks- Hide quoted text -

- Show quoted text -

Hi,
I am wondering if this will work! I tried but it seems that I am doing
something wrong can you help please.

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
* *pict.cropleft = 50
* *pict.cropright = 50
else
* *pict.height = 100
end if- Hide quoted text -

- Show quoted text -

Hi,
Is it possible to Crop thepicturefrom left and right instead of
sizing it "pict.width = 100"
thanks.- Hide quoted text -

- Show quoted text -

Hi,
Thanks, but it seems that I am doing something wrong. Below is the
CompleteMacrothat I have know can you look and see what I am doing
wrong.

Sub add_pictures()

Const PictureHeight = 120
DefaultPicture = "O:\MERCHGRP\AAB\pics\Mpics
\Picture_not_Available.jpg"

Application.ScreenUpdating = False

'delete pictures
For Each shp In ActiveSheet.Shapes
* *If shp.Type = msoPicture Then
* * * shp.Delete
* *End If
Next shp

LastCol = Cells(4, Columns.Count).End(xlToLeft).Row
Rows(9).RowHeight = PictureHeight

For Each Cell In Range("B4:IV4")
* *If Cell < "" Then
* * * Cell.Offset(-3, 0).ClearContents
* * * PictureFound = Dir(Cell.Value)
* * * If PictureFound < "" Then

* * * * *Set pict = ActiveSheet.Pictures. _
* * * * * *Insert(Cell.Value)
* * * * *pict.ShapeRange.LockAspectRatio = msoTrue
* * * * *pict.ShapeRange.Height = PictureHeight
* * * * *pictwidth = pict.Width
* * * * *CellWidth = Cells(9, Cell.Column).Width
* * * * *WidthBorder = CellWidth - pictwidth
* * * * *pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

* * * * *PictHeight = pict.Height
* * * * *CellHeight = Cells(9, Cell.Column).Height
* * * * *HeightBorder = CellHeight - PictHeight
* * * * *pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)

If pict.Width pict.Height Then
* * * *Crop = (CellWidth - pict.Width) / 2
* * * *pict.PictureFormat.CropLeft = Crop
* * * *pict.PictureFormat.CropRight = Crop
* *End If

* *If pict.Height pict.Width Then
* * * *Crop = (CellHeight - pict.Height) / 2
* * * *pict.PictureFormat.CropTop = Crop
* * * *pict.PictureFormat.CropBottom = Crop
* *End If

* * * Else
* * * * *Set pict = ActiveSheet.Pictures. _
* * * * * *Insert(DefaultPicture)
* * * * *pict.ShapeRange.LockAspectRatio = msoTrue
* * * * *pict.ShapeRange.Height = PictureHeight
* * * * *pictwidth = pict.Width
* * * * *CellWidth = Cells(9, Cell.Column).Width
* * * * *WidthBorder = CellWidth - pictwidth
* * * * *pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

* * * * *PictHeight = pict.Height
* * * * *CellHeight = Cells(9, Cell.Column).Height
* * * * *HeightBorder = CellHeight - PictHeight
* * * * *pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)

* *End If
* *End If 'new line
Next Cell
Exit Sub 'new line

End Sub- Hide quoted text -

- Show quoted text -

Hi,
*I just tried the last one you sent and it is giving an error at
"pict.PictureFormat.CropTop = Crop"
Thanks.- Hide quoted text -

- Show quoted text -

Hi,
Thanks, How would I crop the Width more?

Insert picture using Macro..
 

On Jun 19, 10:17*am, Joel wrote:
shaperange was missing

Sub add_pictures()

Const PictureHeight = 120
Folder = "O:\MERCHGRP\AAB\pics\Mpics\"
FName = "Picture_not_Available.jpg"
DefaultPicture = Folder & FName

Application.ScreenUpdating = False

'delete pictures
For Each shp In ActiveSheet.Shapes
* *If shp.Type = msoPicture Then
* * * shp.Delete
* *End If
Next shp

LastCol = Cells(4, Columns.Count).End(xlToLeft).Row
Rows(9).RowHeight = PictureHeight

For Each Cell In Range("B4:IV4")
* *If Cell < "" Then
* * * Cell.Offset(-3, 0).ClearContents
* * * PictureFound = Dir(Cell.Value)
* * * If PictureFound < "" Then

* * * * *Set pict = ActiveSheet.Pictures. _
* * * * * *Insert(Cell.Value)
* * * *Else
* * * * * * * * Set pict = ActiveSheet.Pictures. _
* * * * * *Insert(DefaultPicture)
* * * *End If
* * * * *pict.ShapeRange.LockAspectRatio = msoTrue
* * * * *'pict.ShapeRange.Height = PictureHeight * <=deleted
* * * * *pictwidth = pict.Width
* * * * *CellWidth = Cells(9, Cell.Column).Width
* * * * *WidthBorder = CellWidth - pictwidth
* * * * *pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

* * * * *PictHeight = pict.Height
* * * * *CellHeight = Cells(9, Cell.Column).Height
* * * * *HeightBorder = CellHeight - PictHeight
* * * * *pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)

* * * * *If pict.Width pict.Height Then
* * * * * * Crop = (CellWidth - pict.Width) / 2
* * * * * * pict.ShapeRange.PictureFormat.CropLeft = Crop
* * * * * * pict.ShapeRange.PictureFormat.CropRight = Crop
* * * * *Else
* * * * * * Crop = (CellHeight - pict.Height) / 2
* * * * * * pict.ShapeRange.PictureFormat.CropTop = Crop
* * * * * * pict.ShapeRange.PictureFormat.CropBottom = Crop
* * * * *End If
* *End If 'new line
Next Cell
Exit Sub 'new line

End Sub



" wrote:
On Jun 19, 9:22 am, Joel wrote:
Be a little bit clear about what is not working. *It looks likeyou were only
croping the pictures that were found and not the defaultpicture. *I modified
the code below to fix this problem and to make the code common between the
pictures found and not found.

Sub add_pictures()

Const PictureHeight = 120
Folder = "O:\MERCHGRP\AAB\pics\Mpics\"
FName = "Picture_not_Available.jpg"
DefaultPicture = Folder & FName

Application.ScreenUpdating = False

'delete pictures
For Each shp In ActiveSheet.Shapes
* *If shp.Type = msoPicture Then
* * * shp.Delete
* *End If
Next shp

LastCol = Cells(4, Columns.Count).End(xlToLeft).Row
Rows(9).RowHeight = PictureHeight

For Each Cell In Range("B4:IV4")
* *If Cell < "" Then
* * * Cell.Offset(-3, 0).ClearContents
* * * PictureFound = Dir(Cell.Value)
* * * If PictureFound < "" Then

* * * * *Set pict = ActiveSheet.Pictures. _
* * * * * *Insert(Cell.Value)
* * * *Else
* * * * * * * * Set pict = ActiveSheet.Pictures. _
* * * * * *Insert(DefaultPicture)
* * * *End If
* * * * *pict.ShapeRange.LockAspectRatio = msoTrue
* * * * *pict.ShapeRange.Height = PictureHeight
* * * * *pictwidth = pict.Width
* * * * *CellWidth = Cells(9, Cell.Column).Width
* * * * *WidthBorder = CellWidth - pictwidth
* * * * *pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

* * * * *PictHeight = pict.Height
* * * * *CellHeight = Cells(9, Cell.Column).Height
* * * * *HeightBorder = CellHeight - PictHeight
* * * * *pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)

* * * * *If pict.Width pict.Height Then
* * * * * * Crop = (CellWidth - pict.Width) / 2
* * * * * * pict.PictureFormat.CropLeft = Crop
* * * * * * pict.PictureFormat.CropRight = Crop
* * * * *Else
* * * * * * Crop = (CellHeight - pict.Height) / 2
* * * * * * pict.PictureFormat.CropTop = Crop
* * * * * * pict.PictureFormat.CropBottom = Crop
* * * * *End If
* *End If 'new line
Next Cell
Exit Sub 'new line

End Sub

" wrote:
On Jun 19, 6:59 am, Joel wrote:
I made asmall eror

from
* *If pict.Height 100 Then
* * * *Crop = (CellWidth - pict.Width) / 2
to
* *If pict.Height 100 Then
* * * * Crop = (CellHeight - pict.Height) / 2

" wrote:
On Jun 19, 3:23 am, Joel wrote:
You need to get the height and width of the cell is is going into to center
the cell

CellHeight = range("A1").Height
CellWidth = range("A1").Width

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
* *pict.width = 100
else
* *pict.height = 100
end if
WidthBorder = CellWidth - pict.width
pict.left = Range("A1").left + WidthBorder/2

HeightBorder = CellHeight - pict.height
pict.top = Range("A1").Top + HeightBorder/2

" wrote:
On Jun 18, 2:07 pm, wrote:
On Jun 18, 11:20 am, Joel wrote:

You need to get the larger of the width or height variable and adjust it to 100

pict.LockAspectRatio = msoTrue
if pict.width pict.height then

else
* *pict.height = 100
end if

" wrote:
I have amacrothat I use toinsertpictures in excel but I am having
difficulty with thepicturesize, I would like thepictureto keep the
Aspect Ratio but to have a maximum of 100 height and a maximum 100
width is this possible, any help is appreciated.
Thanks.- Hide quoted text -

- Show quoted text -

Thanks, you are great!.
Is there any way that I can center the pictures in the cell, because
when the width is than the height it ia scaling it to 100 but then
it is being placed slightly on the cell in to the left.
thanks- Hide quoted text -

- Show quoted text -

Hi,
I am wondering if this will work! I tried but it seems that I am doing
something wrong can you help please.

pict.LockAspectRatio = msoTrue
if pict.width pict.height then
* *pict.cropleft = 50
* *pict.cropright = 50
else
* *pict.height = 100
end if- Hide quoted text -

- Show quoted text -

Hi,
Is it possible to Crop thepicturefrom left and right instead of
sizing it "pict.width = 100"
thanks.- Hide quoted text -

- Show quoted text -

Hi,
Thanks, but it seems that I am doing something wrong. Below is the
CompleteMacrothat I have know can you look and see what I am doing
wrong.

Sub add_pictures()

Const PictureHeight = 120
DefaultPicture = "O:\MERCHGRP\AAB\pics\Mpics
\Picture_not_Available.jpg"

Application.ScreenUpdating = False

'delete pictures
For Each shp In ActiveSheet.Shapes
* *If shp.Type = msoPicture Then
* * * shp.Delete
* *End If
Next shp

LastCol = Cells(4, Columns.Count).End(xlToLeft).Row
Rows(9).RowHeight = PictureHeight

For Each Cell In Range("B4:IV4")
* *If Cell < "" Then
* * * Cell.Offset(-3, 0).ClearContents
* * * PictureFound = Dir(Cell.Value)
* * * If PictureFound < "" Then

* * * * *Set pict = ActiveSheet.Pictures. _
* * * * * *Insert(Cell.Value)
* * * * *pict.ShapeRange.LockAspectRatio = msoTrue
* * * * *pict.ShapeRange.Height = PictureHeight
* * * * *pictwidth = pict.Width
* * * * *CellWidth = Cells(9, Cell.Column).Width
* * * * *WidthBorder = CellWidth - pictwidth
* * * * *pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

* * * * *PictHeight = pict.Height
* * * * *CellHeight = Cells(9, Cell.Column).Height
* * * * *HeightBorder = CellHeight - PictHeight
* * * * *pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)

If pict.Width pict.Height Then
* * * *Crop = (CellWidth - pict.Width) / 2
* * * *pict.PictureFormat.CropLeft = Crop
* * * *pict.PictureFormat.CropRight = Crop
* *End If

* *If pict.Height pict.Width Then
* * * *Crop = (CellHeight - pict.Height) / 2
* * * *pict.PictureFormat.CropTop = Crop
* * * *pict.PictureFormat.CropBottom = Crop
* *End If

* * * Else
* * * * *Set pict = ActiveSheet.Pictures. _
* * * * * *Insert(DefaultPicture)
* * * * *pict.ShapeRange.LockAspectRatio = msoTrue
* * * * *pict.ShapeRange.Height = PictureHeight
* * * * *pictwidth = pict.Width
* * * * *CellWidth = Cells(9, Cell.Column).Width
* * * * *WidthBorder = CellWidth - pictwidth
* * * * *pict.Left = Cells(9, Cell.Column).Left + (WidthBorder / 1.8)

* * * * *PictHeight = pict.Height
* * * * *CellHeight = Cells(9, Cell.Column).Height
* * * * *HeightBorder = CellHeight - PictHeight
* * * * *pict.Top = Cells(9, Cell.Column).Top + (HeightBorder / 1.8)

* *End If
* *End If 'new line
Next Cell
Exit Sub 'new line

End Sub- Hide quoted text -

- Show quoted text -

Hi,
*I just tried the last one you sent and it is giving an error at
"pict.PictureFormat.CropTop = Crop"
Thanks.- Hide quoted text -

- Show quoted text -



Hi,
I am still trying to get this correct, Everything that yoou sent works
but I need to change a few thing because when I am testing is when I
find that something need to be different, I would appreciate for your
help.
The part of the macro that needs to be different is below, I want to
see if possible to make the macro to ( If Width height then Crop to
same as height, If height is width then Crop to same as Width)
Thanks.

****************

If pict.Width pict.Height Then
Crop = (CellWidth - pict.Width) / 2
pict.ShapeRange.PictureFormat.CropLeft = Crop
pict.ShapeRange.PictureFormat.CropRight = Crop
Else
Crop = (CellHeight - pict.Height) / 2
pict.ShapeRange.PictureFormat.CropTop = Crop
pict.ShapeRange.PictureFormat.CropBottom = Crop
End If

******************