I have a macro, which import a small picture into a cell - no problem here
:-)

Problem is that the picture is always placed in the upper left corner of the
cell...

I want the picture to be placed in the upper middel of the cell...

But how to do that???

And, just to make things complicated: The cell width can be different each
time the macro is executed....


TIA,

CE

With the macro below you can insert pictures at any range in a worksheet.
The picture can be centered horizontally and/or vertically.
Sub TestInsertPicture()
InsertPicture "C:\FolderName\PictureFileName.gif", _
Range("D10"), True, True
End Sub

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)
' determine positions
With TargetCell
t = .Top
l = .Left
If CenterH Then
w = .Offset(0, 1).Left - .Left
l = l + w / 2 - p.Width / 2
If l < 1 Then l = 1
End If
If CenterV Then
h = .Offset(1, 0).Top - .Top
t = t + h / 2 - p.Height / 2
If t < 1 Then t = 1
End If
End With
' position picture
With p
.Top = t
.Left = l
End With
Set p = Nothing
End Sub
With the macro below you can insert pictures and fit them to any range in a
worksheet.
Sub TestInsertPictureInRange()
InsertPictureInRange "C:\FolderName\PictureFileName.gif", _
Range("B5:D10")
End Sub

Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
' inserts a picture and resizes it to fit the TargetCells range
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)
' determine positions
With TargetCells
t = .Top
l = .Left
w = .Offset(0, .Columns.Count).Left - .Left
h = .Offset(.Rows.Count, 0).Top - .Top
End With
' position picture
With p
.Top = t
.Left = l
.Width = w
.Height = h
End With
Set p = Nothing
End Sub

--
Rui

"Charlotte E." <@ wrote in message
...
I have a macro, which import a small picture into a cell - no problem here
:-)

Problem is that the picture is always placed in the upper left corner of
the cell...

I want the picture to be placed in the upper middel of the cell...

But how to do that???

And, just to make things complicated: The cell width can be different each
time the macro is executed....


TIA,

CE

Perfect - works like a charm - thanks :-)


ruic wrote:
With the macro below you can insert pictures at any range in a
worksheet. The picture can be centered horizontally and/or vertically.
Sub TestInsertPicture()
InsertPicture "C:\FolderName\PictureFileName.gif", _
Range("D10"), True, True
End Sub

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)
' determine positions
With TargetCell
t = .Top
l = .Left
If CenterH Then
w = .Offset(0, 1).Left - .Left
l = l + w / 2 - p.Width / 2
If l < 1 Then l = 1
End If
If CenterV Then
h = .Offset(1, 0).Top - .Top
t = t + h / 2 - p.Height / 2
If t < 1 Then t = 1
End If
End With
' position picture
With p
.Top = t
.Left = l
End With
Set p = Nothing
End Sub
With the macro below you can insert pictures and fit them to any
range in a worksheet.
Sub TestInsertPictureInRange()
InsertPictureInRange "C:\FolderName\PictureFileName.gif", _
Range("B5:D10")
End Sub

Sub InsertPictureInRange(PictureFileName As String, TargetCells As
Range) ' inserts a picture and resizes it to fit the TargetCells range
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)
' determine positions
With TargetCells
t = .Top
l = .Left
w = .Offset(0, .Columns.Count).Left - .Left
h = .Offset(.Rows.Count, 0).Top - .Top
End With
' position picture
With p
.Top = t
.Left = l
.Width = w
.Height = h
End With
Set p = Nothing
End Sub


"Charlotte E." <@ wrote in message
...
I have a macro, which import a small picture into a cell - no
problem here :-)

Problem is that the picture is always placed in the upper left
corner of the cell...

I want the picture to be placed in the upper middel of the cell...

But how to do that???

And, just to make things complicated: The cell width can be
different each time the macro is executed....


TIA,

CE

Rui,

Do you know of a way to adjust this code to use graphics that are not stored
in external files, but embedded in an Access database?

I have an Excel add-in that reads data from an Access file into a new
worksheet. There are pictures (bmp, jpeg, gif) embedded in OLE objects that
I need to transfer to the worksheet but I am at a loss as to how to get them
from a recordset object into the worksheet.

Any insight would be greatly appreciated.

Thanks!
--
terri


"ruic" wrote:

With the macro below you can insert pictures at any range in a worksheet.
The picture can be centered horizontally and/or vertically.
Sub TestInsertPicture()
InsertPicture "C:\FolderName\PictureFileName.gif", _
Range("D10"), True, True
End Sub

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)
' determine positions
With TargetCell
t = .Top
l = .Left
If CenterH Then
w = .Offset(0, 1).Left - .Left
l = l + w / 2 - p.Width / 2
If l < 1 Then l = 1
End If
If CenterV Then
h = .Offset(1, 0).Top - .Top
t = t + h / 2 - p.Height / 2
If t < 1 Then t = 1
End If
End With
' position picture
With p
.Top = t
.Left = l
End With
Set p = Nothing
End Sub
With the macro below you can insert pictures and fit them to any range in a
worksheet.
Sub TestInsertPictureInRange()
InsertPictureInRange "C:\FolderName\PictureFileName.gif", _
Range("B5:D10")
End Sub

Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
' inserts a picture and resizes it to fit the TargetCells range
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)
' determine positions
With TargetCells
t = .Top
l = .Left
w = .Offset(0, .Columns.Count).Left - .Left
h = .Offset(.Rows.Count, 0).Top - .Top
End With
' position picture
With p
.Top = t
.Left = l
.Width = w
.Height = h
End With
Set p = Nothing
End Sub

--
Rui

"Charlotte E." <@ wrote in message
...
I have a macro, which import a small picture into a cell - no problem here
:-)

Problem is that the picture is always placed in the upper left corner of
the cell...

I want the picture to be placed in the upper middel of the cell...

But how to do that???

And, just to make things complicated: The cell width can be different each
time the macro is executed....


TIA,

CE