I created the toolbar as an add in using the method I found at:
http://www.contextures.com/xltoolbar02.html

It is VBA for 2003 but works in 2007. I have found various suggestions
online to add an image, but most of it is using xml, and I'm just using VB.
Can anyone tell me or direct me where to go to remove the caption name and
replace it with an image?

I found this thread, but I don't know enough about VB to know how to
incorporate it into the code listed on the link above, or if that is even
possible. My educated guess is no since the code I'm using is for the whole
menu/toolbar and the code from the thread below looks to be refering to 1
button.
http://www.microsoft.com/office/comm...1-d43c814c205b

Any help would be appreciated. FYI, adding the customized toolbar as an add
in is what I'm looking for, which is why the xml approach didn't seem to work
well for me.

Try something like the following to load a image file as the picture for a
command bar button.

Sub AAA()
Dim Pict As StdPicture
Dim FileName As String
Dim Ctrl As Office.CommandBarButton
FileName = "C:\Path\SomeFile.bmp" '<<< CHANGE
Set Ctrl = Application.CommandBars("Test").Controls(1) '<<< CHANGE
Set Pict = LoadPicture(FileName)
Ctrl.Picture = Pict
End Sub


--
Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)




"vbaexperimenter" wrote in
message ...
I created the toolbar as an add in using the method I found at:
http://www.contextures.com/xltoolbar02.html

It is VBA for 2003 but works in 2007. I have found various suggestions
online to add an image, but most of it is using xml, and I'm just using
VB.
Can anyone tell me or direct me where to go to remove the caption name and
replace it with an image?

I found this thread, but I don't know enough about VB to know how to
incorporate it into the code listed on the link above, or if that is even
possible. My educated guess is no since the code I'm using is for the
whole
menu/toolbar and the code from the thread below looks to be refering to 1
button.
http://www.microsoft.com/office/comm...1-d43c814c205b

Any help would be appreciated. FYI, adding the customized toolbar as an
add
in is what I'm looking for, which is why the xml approach didn't seem to
work
well for me.

Chip, that worked, but now I'm showing two toolbars instead of just one. One
with the name/caption and the other as just the image. The one with just the
image is the one I'm looking for. Here is my current code, it includes the
macro I'm using as well. My macro for the AAA is in there as well. I put your
code under that Sub. I tried to remove various coding, but I couldn't get the
toolbar with the name/caption to go away. Here is what I have as my current
code. Both toolbars work btw. Any suggestions would be helpful.

Option Explicit

Public Const ToolBarName As String = "Tickmarks"
'===========================================
Sub Auto_Open()
Call CreateMenubar
End Sub

'===========================================
Sub Auto_Close()
Call RemoveMenubar
End Sub

'===========================================
Sub RemoveMenubar()
On Error Resume Next
Application.CommandBars(ToolBarName).Delete
On Error GoTo 0
End Sub

'===========================================
Sub CreateMenubar()

Dim iCtr As Long

Dim MacNames As Variant
Dim TipText As Variant

Call RemoveMenubar

MacNames = Array("aaa", _
"bbb")

TipText = Array("AAA tip", _
"BBB tip")

With Application.CommandBars.Add
.Name = ToolBarName
.Left = 200
.Top = 200
.Protection = msoBarNoProtection
.Visible = True
.Position = msoBarLeft

For iCtr = LBound(MacNames) To UBound(MacNames)
With .Controls.Add(Type:=msoControlButton)
.OnAction = "'" & ThisWorkbook.Name & "'!" & MacNames(iCtr)
.TooltipText = TipText(iCtr)
End With
Next iCtr
End With


Dim Pict As StdPicture
Dim FileName As String
Dim Ctrl As Office.CommandBarButton
FileName = "D:\Program Files\Microsoft Office\Office12\Tickmarks\TB.bmp"
'<<< CHANGE
Set Ctrl = Application.CommandBars("Tickmarks").Controls(1) '<<< CHANGE
Set Pict = LoadPicture(FileName)
Ctrl.Picture = Pict
End Sub




'===========================================
Sub AAA()
InsertPicture "D:\Program Files\Microsoft
Office\Office12\Tickmarks\TB.bmp", ActiveCell, 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

Dim Pict As StdPicture
Dim FileName As String
Dim Ctrl As Office.CommandBarButton
FileName = "D:\Program Files\Microsoft Office\Office12\Tickmarks\TB.bmp"
'<<< CHANGE
Set Ctrl = Application.CommandBars("Tickmarks").Controls(1) '<<< CHANGE
Set Pict = LoadPicture(FileName)
Ctrl.Picture = Pict
End Sub


'===========================================
Sub BBB()
MsgBox "bbb"
End Sub

Ok Scratch my last question. I think I got that figured out. My problem right
now is that the button appears as 1 & 2 until I press them then it turns into
the picture that I want. Here is the code I currently have:

Option Explicit

Public Const ToolBarName As String = "MyToolbarName"
'===========================================
Sub Auto_Open()
Call CreateMenubar
End Sub

'===========================================
Sub Auto_Close()
Call RemoveMenubar
End Sub

'===========================================
Sub RemoveMenubar()
On Error Resume Next
Application.CommandBars(ToolBarName).Delete
On Error GoTo 0
End Sub

'===========================================
Sub CreateMenubar()

Dim iCtr As Long

Dim MacNames As Variant
Dim CapNamess As Variant
Dim TipText As Variant

Call RemoveMenubar

MacNames = Array("aaa", _
"bbb")

CapNamess = Array("", _
"")

TipText = Array("AAA tip", _
"BBB tip")

With Application.CommandBars.Add
.Name = ToolBarName
.Left = 200
.Top = 200
.Protection = msoBarNoProtection
.Visible = True
.Position = msoBarLeft

For iCtr = LBound(MacNames) To UBound(MacNames)
With .Controls.Add(Type:=msoControlButton)
.OnAction = "'" & ThisWorkbook.Name & "'!" & MacNames(iCtr)
.Caption = CapNamess(iCtr)
.Style = msoButtonIcon
.FaceId = 71 + iCtr
.TooltipText = TipText(iCtr)
End With
Next iCtr
End With
End Sub

'===========================================
Sub AAA()
InsertPicture "D:\Program Files\Microsoft
Office\Office12\Tickmarks\TB.bmp", ActiveCell, 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

Dim Pict As StdPicture
Dim FileName As String
Dim Ctrl As Office.CommandBarButton
FileName = "D:\Program Files\Microsoft Office\Office12\Tickmarks\TB.bmp"
'<<< CHANGE
Set Ctrl = Application.CommandBars(ToolBarName).Controls(1) '<<< CHANGE
Set Pict = LoadPicture(FileName)
Ctrl.Picture = Pict

End Sub

'===========================================
Sub BBB()
InsertPicture2 "D:\Program Files\Microsoft
Office\Office12\Tickmarks\IM.bmp", ActiveCell, True, True
End Sub

Sub InsertPicture2(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

Dim Pict As StdPicture
Dim FileName As String
Dim Ctrl As Office.CommandBarButton
FileName = "D:\Program Files\Microsoft Office\Office12\Tickmarks\IM.bmp"
'<<< CHANGE
Set Ctrl = Application.CommandBars(ToolBarName).Controls(2) '<<< CHANGE
Set Pict = LoadPicture(FileName)
Ctrl.Picture = Pict

End Sub

I don't quite understand what you're accomplishing by inserting the picture by
clicking on the button. You want the picture on the button right away--and you
want to have a macro assigned to the button that actually does something
important.

Maybe you could (manually) put the pictures on a worksheet in the workbook with
the code. Then the macro that creates the toolbar can use those pictures. That
way, you don't have to worry about the pictures not being available.

If you want to try:

Option Explicit
Public Const ToolBarName As String = "MyToolbarName"
Sub Auto_Open()
Call CreateMenubar
End Sub
Sub Auto_Close()
Call RemoveMenubar
End Sub
Sub RemoveMenubar()
On Error Resume Next
Application.CommandBars(ToolBarName).Delete
On Error GoTo 0
End Sub
Sub CreateMenubar()

Dim iCtr As Long

Dim MacNames As Variant
Dim CapNames As Variant
Dim TipText As Variant
Dim PictNames As Variant
Dim PictWks As Worksheet

Call RemoveMenubar

MacNames = Array("aaa", _
"bbb")

CapNames = Array("AAA Caption", _
"BBB Caption")

TipText = Array("AAA tip", _
"BBB tip")

PictNames = Array("Pic1", "Pic2")

Set PictWks = ThisWorkbook.Worksheets("Pictures")

With Application.CommandBars.Add
.Name = ToolBarName
.Left = 200
.Top = 200
.Protection = msoBarNoProtection
.Visible = True
.Position = msoBarFloating

For iCtr = LBound(MacNames) To UBound(MacNames)
PictWks.Pictures(PictNames(iCtr)).Copy
With .Controls.Add(Type:=msoControlButton)
.OnAction = "'" & ThisWorkbook.Name & "'!" & MacNames(iCtr)
.Caption = CapNames(iCtr)
.Style = msoButtonIconAndCaption
.PasteFace
.TooltipText = tip_text(iCtr)
End With
Next iCtr

End With
End Sub
Sub AAA()
MsgBox "aaa"
End Sub
Sub BBB()
MsgBox "bbb"
End Sub

The AAA and BBB subs are just stubs. You can put your macro code that does the
real work there--or call your macros from them.

vbaexperimenter wrote:

Ok Scratch my last question. I think I got that figured out. My problem right
now is that the button appears as 1 & 2 until I press them then it turns into
the picture that I want. Here is the code I currently have:

Option Explicit

Public Const ToolBarName As String = "MyToolbarName"
'===========================================
Sub Auto_Open()
Call CreateMenubar
End Sub

'===========================================
Sub Auto_Close()
Call RemoveMenubar
End Sub

'===========================================
Sub RemoveMenubar()
On Error Resume Next
Application.CommandBars(ToolBarName).Delete
On Error GoTo 0
End Sub

'===========================================
Sub CreateMenubar()

Dim iCtr As Long

Dim MacNames As Variant
Dim CapNamess As Variant
Dim TipText As Variant

Call RemoveMenubar

MacNames = Array("aaa", _
"bbb")

CapNamess = Array("", _
"")

TipText = Array("AAA tip", _
"BBB tip")

With Application.CommandBars.Add
.Name = ToolBarName
.Left = 200
.Top = 200
.Protection = msoBarNoProtection
.Visible = True
.Position = msoBarLeft

For iCtr = LBound(MacNames) To UBound(MacNames)
With .Controls.Add(Type:=msoControlButton)
.OnAction = "'" & ThisWorkbook.Name & "'!" & MacNames(iCtr)
.Caption = CapNamess(iCtr)
.Style = msoButtonIcon
.FaceId = 71 + iCtr
.TooltipText = TipText(iCtr)
End With
Next iCtr
End With
End Sub

'===========================================
Sub AAA()
InsertPicture "D:\Program Files\Microsoft
Office\Office12\Tickmarks\TB.bmp", ActiveCell, 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

Dim Pict As StdPicture
Dim FileName As String
Dim Ctrl As Office.CommandBarButton
FileName = "D:\Program Files\Microsoft Office\Office12\Tickmarks\TB.bmp"
'<<< CHANGE
Set Ctrl = Application.CommandBars(ToolBarName).Controls(1) '<<< CHANGE
Set Pict = LoadPicture(FileName)
Ctrl.Picture = Pict

End Sub

'===========================================
Sub BBB()
InsertPicture2 "D:\Program Files\Microsoft
Office\Office12\Tickmarks\IM.bmp", ActiveCell, True, True
End Sub

Sub InsertPicture2(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

Dim Pict As StdPicture
Dim FileName As String
Dim Ctrl As Office.CommandBarButton
FileName = "D:\Program Files\Microsoft Office\Office12\Tickmarks\IM.bmp"
'<<< CHANGE
Set Ctrl = Application.CommandBars(ToolBarName).Controls(2) '<<< CHANGE
Set Pict = LoadPicture(FileName)
Ctrl.Picture = Pict

End Sub

--

Dave Peterson

Dave,
I essentially want a toolbar where the buttons are labled with the image
the macro will insert into the worksheet. I also need it as an addin so it
can be added to other computers/users. I inserted all the pictures to my
file tickmarks.xlam. I then copied and pasted your code into the module. It
keeps erroring out on the line:

PictWks.Pictures(PictNames(iCtr)).Copy

Here is the code again with your changes and the name of the sheet and
pictures

Option Explicit
Public Const ToolBarName As String = "MyToolbarName"
Sub Auto_Open()
Call CreateMenubar
End Sub
Sub Auto_Close()
Call RemoveMenubar
End Sub
Sub RemoveMenubar()
On Error Resume Next
Application.CommandBars(ToolBarName).Delete
On Error GoTo 0
End Sub
Sub CreateMenubar()

Dim iCtr As Long

Dim MacNames As Variant
Dim CapNames As Variant
Dim TipText As Variant
Dim PictNames As Variant
Dim PictWks As Worksheet

Call RemoveMenubar

MacNames = Array("Prior_Year", _
"Recalculated")

CapNames = Array("Prior_Year", _
"Recalculated")

TipText = Array("Prior_Year", _
"Recalculated")

PictNames = Array("Prior_Year", "Recalculated")

Set PictWks = ThisWorkbook.Worksheets("Pictures")

With Application.CommandBars.Add
..Name = ToolBarName
..Left = 200
..Top = 200
..Protection = msoBarNoProtection
..Visible = True
..Position = msoBarFloating

For iCtr = LBound(MacNames) To UBound(MacNames)
PictWks.Pictures(PictNames(iCtr)).Copy
With .Controls.Add(Type:=msoControlButton)
..OnAction = "'" & ThisWorkbook.Name & "'!" & MacNames(iCtr)
..Caption = CapNames(iCtr)
..Style = msoButtonIconAndCaption
..PasteFace
..TooltipText = TipText(iCtr)
End With
Next iCtr

End With
End Sub

'===========================================
Sub Prior_Year()
InsertPicture "D:\Program Files\Microsoft
Office\Office12\Tickmarks\Prior_Year.bmp", ActiveCell, 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

'===========================================
Sub Recalculated()
InsertPicture2 "D:\Program Files\Microsoft
Office\Office12\Tickmarks\Recalculated.bmp", ActiveCell, True, True
End Sub

Sub InsertPicture2(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

And you have pictures named Prior_Year and Recalculated on a worksheet named
Pictures in that workbook with the code?

If no, then you have some work to do.

If yes, what error do you see?

vbaexperimenter wrote:

Dave,
I essentially want a toolbar where the buttons are labled with the image
the macro will insert into the worksheet. I also need it as an addin so it
can be added to other computers/users. I inserted all the pictures to my
file tickmarks.xlam. I then copied and pasted your code into the module. It
keeps erroring out on the line:

PictWks.Pictures(PictNames(iCtr)).Copy

Here is the code again with your changes and the name of the sheet and
pictures

Option Explicit
Public Const ToolBarName As String = "MyToolbarName"
Sub Auto_Open()
Call CreateMenubar
End Sub
Sub Auto_Close()
Call RemoveMenubar
End Sub
Sub RemoveMenubar()
On Error Resume Next
Application.CommandBars(ToolBarName).Delete
On Error GoTo 0
End Sub
Sub CreateMenubar()

Dim iCtr As Long

Dim MacNames As Variant
Dim CapNames As Variant
Dim TipText As Variant
Dim PictNames As Variant
Dim PictWks As Worksheet

Call RemoveMenubar

MacNames = Array("Prior_Year", _
"Recalculated")

CapNames = Array("Prior_Year", _
"Recalculated")

TipText = Array("Prior_Year", _
"Recalculated")

PictNames = Array("Prior_Year", "Recalculated")

Set PictWks = ThisWorkbook.Worksheets("Pictures")

With Application.CommandBars.Add
.Name = ToolBarName
.Left = 200
.Top = 200
.Protection = msoBarNoProtection
.Visible = True
.Position = msoBarFloating

For iCtr = LBound(MacNames) To UBound(MacNames)
PictWks.Pictures(PictNames(iCtr)).Copy
With .Controls.Add(Type:=msoControlButton)
.OnAction = "'" & ThisWorkbook.Name & "'!" & MacNames(iCtr)
.Caption = CapNames(iCtr)
.Style = msoButtonIconAndCaption
.PasteFace
.TooltipText = TipText(iCtr)
End With
Next iCtr

End With
End Sub

'===========================================
Sub Prior_Year()
InsertPicture "D:\Program Files\Microsoft
Office\Office12\Tickmarks\Prior_Year.bmp", ActiveCell, 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

'===========================================
Sub Recalculated()
InsertPicture2 "D:\Program Files\Microsoft
Office\Office12\Tickmarks\Recalculated.bmp", ActiveCell, True, True
End Sub

Sub InsertPicture2(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

--

Dave Peterson