pasting pictures

[kevin carter]

hi
i have this code that copies a picture from one worksheet(sheet1) to another
worksheet(main)in a cell
and deletes any picture in that cell only

Sub picrow1()
Dim mypic As Picture
Dim myAddr As String
Set mypic = ActiveSheet.Pictures(Application.Caller)

Select Case LCase(mypic.Name)
Case Is = "picture 4": myAddr = "A7"
Case Is = "picture 7": myAddr = "A7"
Case Is = "picture 3": myAddr = "A7"
Case Is = "picture 12": myAddr = "A7"
Case Else
Exit Sub
End Select
mypic.Copy
With ThisWorkbook.Worksheets("MAIN")
On Error Resume Next
.Pictures("mypicture_" & myAddr).Delete
On Error Resume Next
ThisWorkbook.Worksheets("MAIN").Select
.Select
.Range(myAddr).Select
.Paste
.Pictures(.Pictures.Count).Name = "mypicture_" & myAddr
End With
End Sub

The problem is that the picture does not get pasted in the same location in
the cell
is there anyway of forcing the position in the cell ie top left?

thanks in advance

kevin

 

[John McGimpsey]

One way:

Public Sub picrow1()
Dim mypic As Picture
Dim myAddr As String
Dim rDest As Range
Set mypic = ActiveSheet.Pictures(Application.Caller)

Select Case LCase(mypic.Name)
Case "picture 4", "picture 7", "picture 3", "picture 12"
myAddr = "A7"
Case Else
Exit Sub
End Select
mypic.Copy
With ThisWorkbook.Worksheets("MAIN")
On Error Resume Next
.Pictures("mypicture_" & myAddr).Delete
On Error Resume Next
Set rDest = .Range(myAddr)
.Paste
With .Pictures(.Pictures.Count)
.Name = "mypicture_" & myAddr
.Top = rDest.Top
.Left = rDest.Left
End With
End With
End Sub

 

[kevin carter]

thanks a lot works a treat

One way:

Public Sub picrow1()
Dim mypic As Picture
Dim myAddr As String
Dim rDest As Range
Set mypic = ActiveSheet.Pictures(Application.Caller)

Select Case LCase(mypic.Name)
Case "picture 4", "picture 7", "picture 3", "picture 12"
myAddr = "A7"
Case Else
Exit Sub
End Select
mypic.Copy
With ThisWorkbook.Worksheets("MAIN")
On Error Resume Next
.Pictures("mypicture_" & myAddr).Delete
On Error Resume Next
Set rDest = .Range(myAddr)
.Paste
With .Pictures(.Pictures.Count)
.Name = "mypicture_" & myAddr
.Top = rDest.Top
.Left = rDest.Left
End With
End With
End Sub