Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Copy several photos in a macro
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 1
Default Copy several photos in a macro
Hi everyone:

I have a worksheet with 4 pictures on it, I need to copy this pictures in
the same worsheet but in a diferent location, I need to make the picture name
generic.
I want to make the following macro to work with any picture name:

Sub FotoCopy()
'
' FotoCopy Macro
' Macro recorded 3/16/2007 by ER
'
' Keyboard Shortcut: Ctrl+d
'
ActiveSheet.Shapes("Picture 339").Select
Selection.Copy
ActiveSheet.Shapes("Picture 253").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 225.75
Selection.ShapeRange.IncrementTop -12#
ActiveSheet.Shapes("Picture 335").Select
Selection.Copy
ActiveSheet.Shapes("Picture 261").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 226.5
Selection.ShapeRange.IncrementTop -12#
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 11
ActiveSheet.Shapes("Picture 336").Select
Selection.Copy
ActiveSheet.Shapes("Picture 271").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 226.5
Selection.ShapeRange.IncrementTop -12#
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 20
ActiveSheet.Shapes("Picture 337").Select
Selection.Copy
ActiveSheet.Shapes("Picture 281").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 226.5
Selection.ShapeRange.IncrementTop -13.5
End Sub

Thank you for you help
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default Copy several photos in a macro
Learn Macro put a lot of code that is unecessary. this code is much simplier
than original code. You may want to adjust these two lines

where 1st picture is located, change as required
ScrollCount = 4

Spacing between picture is 10, change as required
ScrollCount = ScrollCount + 10 the


Sub FotoCopy()
'
' FotoCopy Macro
' Macro recorded 3/16/2007 by ER
'
' Keyboard Shortcut: Ctrl+d
'
ScrollCount = 4
For Each MyPicture In ActiveSheet.Shapes
ActiveWindow.ScrollRow = ScrollCount
ActiveSheet.Shapes(MyPicture.Name).Select
Selection.Copy
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 225.75
Selection.ShapeRange.IncrementTop -12#
ScrollCount = ScrollCount + 10
Next MyPicture
End Sub


"Get a file name inside a macro" wrote:

Hi everyone:

I have a worksheet with 4 pictures on it, I need to copy this pictures in
the same worsheet but in a diferent location, I need to make the picture name
generic.
I want to make the following macro to work with any picture name:

Sub FotoCopy()
'
' FotoCopy Macro
' Macro recorded 3/16/2007 by ER
'
' Keyboard Shortcut: Ctrl+d
'
ActiveSheet.Shapes("Picture 339").Select
Selection.Copy
ActiveSheet.Shapes("Picture 253").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 225.75
Selection.ShapeRange.IncrementTop -12#
ActiveSheet.Shapes("Picture 335").Select
Selection.Copy
ActiveSheet.Shapes("Picture 261").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 226.5
Selection.ShapeRange.IncrementTop -12#
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 11
ActiveSheet.Shapes("Picture 336").Select
Selection.Copy
ActiveSheet.Shapes("Picture 271").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 226.5
Selection.ShapeRange.IncrementTop -12#
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 20
ActiveSheet.Shapes("Picture 337").Select
Selection.Copy
ActiveSheet.Shapes("Picture 281").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 226.5
Selection.ShapeRange.IncrementTop -13.5
End Sub

Thank you for you help
Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 27,285
Default Copy several photos in a macro
State the cell under the upper left corner of each picture and where you
want each picture copied to in terms of what the cell would be under the
upper left corner.

Sub CopyPictures()
Dim vCurrent As Variant, vFuture As Variant
Dim i As Long, pic As Picture
vCurrent = Array("A1", "A11", "A21", "A31")
vFuture = Array("M11", "M1", "M31", "M21")
For i = LBound(vCurrent) To UBound(vCurrent)
For Each pic In ActiveSheet.Pictures
If pic.TopLeftCell.Address(0, 0) = vCurrent(i) Then
pic.Copy
Range(vFuture(i)).Select
ActiveSheet.Paste
Exit For
End If
Next pic
Next i
End Sub

You have to specify something about the pictures to use to identify which
picture to copy to where. Hopefully specifying the cell underneath the
upper left corner is consistent with what you are doing.

--
Regards,
Tom Ogilvy

"Get a file name inside a macro"
m wrote in message
...
Hi everyone:

I have a worksheet with 4 pictures on it, I need to copy this pictures in
the same worsheet but in a diferent location, I need to make the picture
name
generic.
I want to make the following macro to work with any picture name:

Sub FotoCopy()
'
' FotoCopy Macro
' Macro recorded 3/16/2007 by ER
'
' Keyboard Shortcut: Ctrl+d
'
ActiveSheet.Shapes("Picture 339").Select
Selection.Copy
ActiveSheet.Shapes("Picture 253").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 225.75
Selection.ShapeRange.IncrementTop -12#
ActiveSheet.Shapes("Picture 335").Select
Selection.Copy
ActiveSheet.Shapes("Picture 261").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 226.5
Selection.ShapeRange.IncrementTop -12#
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 11
ActiveSheet.Shapes("Picture 336").Select
Selection.Copy
ActiveSheet.Shapes("Picture 271").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 226.5
Selection.ShapeRange.IncrementTop -12#
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 20
ActiveSheet.Shapes("Picture 337").Select
Selection.Copy
ActiveSheet.Shapes("Picture 281").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 226.5
Selection.ShapeRange.IncrementTop -13.5
End Sub

Thank you for you help


Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Hybrid Mode Hybrid Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
How to Copy Excel Workbook - Hyperlinks - Folder of Photos - to CD nokomis Excel Worksheet Functions 1 February 9th 09 04:31 AM
How to Copy Excel Workbook - Hyperlinks - Folder of Photos - to CD nokomis Excel Worksheet Functions 0 February 8th 09 11:56 PM
Sorting with photos Lewis SHanks Excel Discussion (Misc queries) 1 November 18th 08 04:53 PM
Photos Sam Excel Worksheet Functions 1 July 9th 08 04:00 PM
How do I copy and edit photos received in an excel spreadsheet Brian Sydney Excel Discussion (Misc queries) 1 July 6th 08 01:05 PM


All times are GMT +1. The time now is 02:41 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement