#1   Report Post  
Kevin
 
Posts: n/a
Default macro problem

Thanks for Reply
i am copying and pasting differnetly
i have included code below

Application.ScreenUpdating = False
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 57", "picture 60", "picture 63", "picture
66", "picture 72", "picture 75", "picture 78", "picture 81", "picture
84", "picture 54"
myAddr = "D10"
Case Else
Exit Sub
End Select
mypic.Copy
With ThisWorkbook.Worksheets("TEMPLATE")
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
ThisWorkbook.Worksheets("TEMPLATE").Select
Range("A1").Select
Application.ScreenUpdating = True

thanks in advance

kevin
  #2   Report Post  
Dave Peterson
 
Posts: n/a
Default

Actually, your code is pretty much the same as Jim's code.

You use
mypic.copy
and later
ThisWorkbook.Worksheets("TEMPLATE").paste
(albeit that it's wrapped in a "with/end with" statement.

But I'm guessing you mean that the pasted picture has the same macro associated
with it.

You could get rid of that macro assignment in this section of code:

With .Pictures(.Pictures.Count)
.Name = "mypicture_" & myAddr
.Top = rDest.Top
.Left = rDest.Left
.OnAction = ""
End With

That .onaction is the added line.



Kevin wrote:

Thanks for Reply
i am copying and pasting differnetly
i have included code below

Application.ScreenUpdating = False
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 57", "picture 60", "picture 63", "picture
66", "picture 72", "picture 75", "picture 78", "picture 81", "picture
84", "picture 54"
myAddr = "D10"
Case Else
Exit Sub
End Select
mypic.Copy
With ThisWorkbook.Worksheets("TEMPLATE")
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
ThisWorkbook.Worksheets("TEMPLATE").Select
Range("A1").Select
Application.ScreenUpdating = True

thanks in advance

kevin


--

Dave Peterson
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

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
Record Macro Relative does not work? lbbss Excel Discussion (Misc queries) 3 December 13th 04 09:43 PM
Record Macro Relative does not work? lbbss Excel Discussion (Misc queries) 1 December 13th 04 08:55 PM
Macro Problem Kevin Excel Discussion (Misc queries) 1 December 9th 04 07:55 PM
Import chart to Power Point and Macro problem Woody13 Excel Discussion (Misc queries) 1 December 8th 04 06:47 PM
Macro and If Statement SATB Excel Discussion (Misc queries) 2 December 3rd 04 05:46 PM


All times are GMT +1. The time now is 09: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"