@KAM_Mumin
Copy image from sheet and paste on another.
Here is an example, you just need to set it to your liking.
SubImageCopy()
Dim arrCells()
Dim sha image as shape
Dim varAvailable
Dim dblLinks as a double
Dim dblOben As Double
' Array with all start and destination addresses for the images - complete accordingly!
arrCells = Array(Array("A1", "A3", "A2"), Array("A1", "E1", "I1"))
With worksheets ("Sheet2")
' loop over all shapes in "Sheet1"
For each shaImage in worksheets ("Sheet1").Shapes
' Check if the address of the top left cell of the current shape is in the array
varexists = Application.Match(shaImage.TopLeftCell.Address(0, 0), arrCells(0), 0)
' If present, Match returns a numeric value
If IsNumeric(varExists) Then
'Copy current image
shaImage.Copy
' Paste copy
.Paste
' Determine the position of the left border of the target cell
dblLeft = .Range(arrCells(1)(varExists - 1)).Left
' Determine the position of the top edge of the target cell
dblTop = .Range(arrCells(1)(varExisting - 1)).Top
' Reference to the last inserted shape
With .Shapes(.Shapes.Count)
' Assign positions
.Links = dblLinks
.Top = dblTop
end with
end if
Next sha picture
end with
end sub
Hope I could help you.
NikolinoDE
I know I don't know anything (Socrates)
