Image pasting to incorrect cells or bad location within cells

[DonFlak]

Let me start by saying, I am by no means an expert. I have a workbook
that has the user answer two questions and based on the answers to
those questions, selcts predetermined data, in this case, a colum of 7
cells and 1 of 30 images to copy and past into a seperate workbook
that the macro opens after the questions have been answered.

A small part of the code is shown below:

ActiveCell.FormulaR1C1 = "1"
Range("B7").Select
ActiveCell.FormulaR1C1 = "0"
Range("B8").Select
ActiveCell.FormulaR1C1 = "0"
Sheets("Reports").Select
Range("A1").Select
Workbooks.Open Filename:="T:\FIN\NEW-TACS-PLAN-OT.xls",
UpdateLinks:=False
Windows("Report.xls").Activate
Sheets("Reference").Select
If Range("D3") = "1" Then
ActiveSheet.Shapes("Picture 1").Select
Selection.Copy
Windows("NEW-TACS-PLAN-OT.xls").Activate
Sheets("DISTRICT ROLL-UP").Select
Range("F29").Select
ActiveSheet.Paste
Sheets("FUNC 1").Select
Range("F29").Select
ActiveSheet.Paste

When this occurs, the image "Picture 1" or for that matter, any of the
30 images paste sometimes in the cell but not aligned as I would
like. For some reason, although the exact same code, 3 of the
variables cause the image to paste 1 cell to the right of the intended
destination. I have rechecked the cell destinations and they are
correct.

Does anyone have an idea how I can get the images to paste where I
need them to, aligned properly?

 

[JE McGimpsey]

One way:

Dim vWorksheetNames As Variant
Dim vName As Variant
Dim picSource As Picture
Dim picDest As Picture

Workbooks.Open _
Filename:="T:\FIN\NEW-TACS-PLAN-OT.xls", _
UpdateLinks:=False
With Workbooks("Report.xls").Sheets("Reference")
If .Range("D3").Value = "1" Then
Set picSource = .Pictures("Picture 1")
With Workbooks("NEW-TACS-PLAN-OT.xls")
vWorksheetNames = Array("DISTRICT ROLL-UP", "FUNC 1")
For Each vName In vWorksheetNames
With .Worksheets(vName)
picSource.Copy
.Paste
Set picDest = .Pictures(.Pictures.Count)
With Range("F29")
picDest.Top = .Top
picDest.Left = .Left
End With
End With
Next vName
End With
End If
End With

Note that no selection is needed.

 

[JE McGimpsey]

Oops - missed qualifying a reference:

Dim vWorksheetNames As Variant
Dim vName As Variant
Dim picSource As Picture
Dim picDest As Picture

Workbooks.Open _
Filename:="T:\FIN\NEW-TACS-PLAN-OT.xls", _
UpdateLinks:=False
With Workbooks("Report.xls").Sheets("Reference")
If .Range("D3").Value = "1" Then
Set picSource = .Pictures("Picture 1")
With Workbooks("NEW-TACS-PLAN-OT.xls")
vWorksheetNames = Array("DISTRICT ROLL-UP", "FUNC 1")
For Each vName In vWorksheetNames
With .Worksheets(vName)
picSource.Copy
.Paste
Set picDest = .Pictures(.Pictures.Count)
With .Range("F29")
picDest.Top = .Top
picDest.Left = .Left
End With
End With
Next vName
End With
End If
End With

 

[DonFlak]

Thanks that works, but of course you knew it would.

Is there any way to get it to align to the middle of the cell. The
image is about half the width of the column and although your code
places the image in the cell it of course aligns to the left. I tried
changing the .Left to .Middle and / or .Center and they didn't work.
Is there a way to bump the image down at all? The destination cell
happens to have a white cell background with a black cell border. It
would be tremendous if I could get the image to place inside of the
cell and inside of the border instead of on top of the border.

Thanks for your asssitance.

 

[JE McGimpsey]

Well, you can't just make up properties for Range objects...

And pictures will always exist on the Drawing Layer above the cells
(i.e., cells can only hold values or formulae).

This will center the picture over the cell:

With .Range("F29")
picDest.Top = .Top + (.Height - picDest.Height) / 2
picDest.Left = .Left + (.Width - picDest.Width) / 2
End With

That presumes that F29 is larger than your pasted pic, of course.

 

[DonFlak]

Brilliant. Thanks so much.

Don