Here is what I have so far:
Working with two workbooks
Source: Hot List.xls \ Snapshot
Destination: SnapShot_Report.xls \ New worksheets automatically added as
needed
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Option Explicit
Public Sub SnapShot_Run_Multiple_Reports()
Dim I As Integer
Dim ShName As String
Dim Sht As Worksheet
Dim buttoms As Shape
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Application.Workbooks.Open ThisWorkbook.Path & "\Hot List.xls"
ThisWorkbook.Sheets("Tickers").Activate
For Each Sht In Sheets ' delete all sheets with previous results firstly
'If Sht.Name <> "Tickers" Then
'Sht.Delete
'End If
If Sht.Name = "Tickers" Or Sht.Name = "AllCos" Then
' Do nothing
Else
Sht.Delete
End If
Next
For I = 2 To 500
ThisWorkbook.Sheets("Tickers").Activate
If Cells(I, 1) = "" Then Exit For
ShName = RemoveColons(Cells(I, 1)) 'name for new sheet = ticker name
ThisWorkbook.Worksheets.Add.Name = ShName
ThisWorkbook.Sheets("Tickers").Activate
Workbooks("Hot List.xls").Activate
Windows("Hot List.xls").Activate 'Added by SteveC
Sheets("SnapShot").Select 'Added by SteveC
Sheets("Snapshot").Range("E4") = ThisWorkbook.Sheets("Tickers").Cells(I,
1)
Sheets("Snapshot").Range("R39") =
ThisWorkbook.Sheets("Tickers").Cells(I, 2)
Application.Run "batman"
Workbooks("Hot List.xls").Sheets("Snapshot").Cells.Copy
With ThisWorkbook.Sheets(ShName).Range("A1")
.PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Workbooks("Hot List.xls").Sheets("Snapshot").Cells.Copy
.PasteSpecial _
Paste:=xlPasteFormats, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Workbooks("Hot List.xls").Sheets("Snapshot").Cells.Copy
.PasteSpecial _
Paste:=xlPasteColumnWidths, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
CopyChartsToPictures ThisWorkbook.Sheets(ShName), ActiveSheet
End With
' Workbooks("Hot
List.xls").Sheets("Snapshot").Range("c48:i64").CopyPicture _
' Appearance:=xlScreen, Format:=xlPicture
' With ThisWorkbook.Sheets(ShName).Range("c48").Select
' ActiveSheet.PasteSpecial Format:="Picture (Enhanced Metafile)",
Link:=False _
' , DisplayAsIcon:=False
'End With
Application.CutCopyMode = False
' Range("A1:IV65536").Select
' Selection.Copy
'ThisWorkbook.Activate
' Sheets(ShName).Select
' Range("A1").Select
' ActiveSheet.Paste
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False 'Steve C Added This Line
'Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A1").Select
' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
'delete all buttoms on sheet now
' For Each buttoms In ThisWorkbook.ActiveSheet.Shapes
' buttoms.Delete
' Next
ActiveSheet.Buttons.Delete
Next I
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Private Function RemoveColons(s As String) As String
Dim I As Long
RemoveColons = ""
For I = 1 To Len(s)
If Mid(s, I, 1) = ":" Then RemoveColons = RemoveColons & " " Else
RemoveColons = RemoveColons & Mid(s, I, 1)
Next I
End Function
Sub Batman()
Dim Refreshbutton As CommandBarButton
Set Refreshbutton =
Application.CommandBars.FindControl(Tag:="menurefreshdatasheet")
Refreshbutton.Execute
Refreshbutton.Execute
Application.Run "'Hot List.xls'!AutoScaleYAxes"
End Sub
Sub CopyChartsToPictures(wsSource As Worksheet, wsDest As Worksheet)
Dim nPicCnt As Long
Dim chtObj As ChartObject
'Dim wsSource As Worksheet
'Dim wsDest As Worksheet
Dim pic As picture
'Dim I As Long
Set wsSource = Workbooks("Book2").Worksheets("Sheet1")
Set wsDest = Workbooks("Book3").Worksheets("Sheet1")
nPicCnt = wsDest.Pictures.Count
For I = 1 To wsSource.ChartObjects.Count
Set chtObj = wsSource.ChartObjects(I)
chtObj.CopyPicture Appearance:=xlScreen, Format:=xlPicture
wsDest.Paste
nPicCnt = nPicCnt + 1
With wsDest.Pictures(nPicCnt)
.Left = chtObj.Left
.Top = chtObj.Top
End With
Next
End Sub
"SteveC" wrote:
> I think I'm close.
>
> Issue 1)
> ThisWorkbook.Sheets(ShName) is the destination sheet where I want to paste
> the charts (and everything else).
>
> Another workbook / worksheet, Hot List.xls / Snapshot, is the source sheet
> containing charts (and everything else).
>
> I'll try to figure this out.
>
> Issue 2)
> Don't no if related, but:
>
> I get an error: compile error: variable not defined
>
> the debugger highlights this the I in: For I = 1 To
> wsSource.ChartObjects.Count within the following modified code:
>
>
>
> Sub CopyChartsToPictures(wsSource As Worksheet, wsDest As Worksheet)
> Dim nPicCnt As Long
> Dim chtObj As ChartObject
> 'Dim wsSource As Worksheet
> 'Dim wsDest As Worksheet
> Dim pic As picture
> 'Dim I As Long
>
> Set wsSource = Workbooks("Book2").Worksheets("Sheet1")
> Set wsDest = Workbooks("Book3").Worksheets("Sheet1")
>
> nPicCnt = wsDest.Pictures.Count
>
> For I = 1 To wsSource.ChartObjects.Count
> Set chtObj = wsSource.ChartObjects(I)
>
> chtObj.CopyPicture Appearance:=xlScreen, Format:=xlPicture
>
> wsDest.Paste
>
> nPicCnt = nPicCnt + 1
> With wsDest.Pictures(nPicCnt)
> .Left = chtObj.Left
> .Top = chtObj.Top
> End With
> Next
>
> End Sub
>
> "Peter T" wrote:
>
> > Hi Steve,
> >
> > > copying and pasting the charts as pictures would be embedded in a larger
> > > piece of code, which have the following dims already, which might conflict
> > > with your dims:
> >
> > Although you could amend and embed my eample into your existing code there's
> > anotrher way, referring to the example
> >
> > Change -
> > Sub test()
> > to -
> > Sub CopyChartsToPictures(wsSource As Worksheet, wsDest As Worksheet)
> >
> > Delete or comment the two Dim ref's to wsSource and wsDest
> >
> > In your existing code add a line something like this -
> >
> > CopyChartsToPictures ThisWorkbook.Sheets(ShName), ActiveSheet
> >
> > If I follow, ThisWorkbook.Sheets(ShName) is the sheet containing charts to
> > be copied as pictures and ActiveSheet is the sheet where they are to be
> > pasted. If not, amend the sheet references to suit.
> >
> > > For Each buttoms In ThisWorkbook.ActiveSheet.Shapes
> > > buttoms.Delete
> > > Next
> > > this might be deleting the chart pictures as well? An MVP sent me a link
> > to
> > > a site showing how to delete buttons only, but haven't digged into to it
> > yet.
> >
> > Try simply -
> > ActiveSheet.Buttons.Delete
> >
> > deletes all buttons inserted from the Forms menu (not ActiveX Commandbuttons
> > from the Controls Toolbox menu)
> >
> > Notice I didn't qualify ActiveSheet to ThisWorkbook (this file containing
> > the code). The ActiveSheet can only be the the activesheet in the
> > activeworkbook, which may or may not be ThisWorkbook. Perhaps you need to be
> > more explicit aboput which sheet you need to refer to.
> >
> > Regards,
> > Peter T
> >
> >
> > "SteveC" <(E-Mail Removed)> wrote in message
> > news:CFC2AD44-806A-4548-A54C-(E-Mail Removed)...
> > > Peter,
> > >
> > > copying and pasting the charts as pictures would be embedded in a larger
> > > piece of code, which have the following dims already, which might conflict
> > > with your dims:
> > >
> > > Dim I As Integer
> > > Dim ShName As String
> > > Dim Sht As Worksheet
> > > Dim buttoms As Shape
> > >
> > > since I"m a novice at vba, don't really know how to modify your code
> > without
> > > pasting all my original code here (there's a lot).
> > >
> > > here is a piece of code that might be simpler to embed in my existing
> > code:
> > >
> > > Workbooks("Hot
> > List.xls").Sheets("Snapshot").Range("c48:i64").CopyPicture _
> > > Appearance:=xlScreen, Format:=xlPicture
> > >
> > > But when I try to paste this into the new worksheet, it doesn't work:
> > >
> > > With ThisWorkbook.Sheets(ShName).Range("c48").Select
> > > ActiveSheet.PasteSpecial Format:="Picture (Enhanced Metafile)",
> > > Link:=False _
> > > , DisplayAsIcon:=False
> > >
> > > Is there a quick fix for this, given the dim definitions above?
> > >
> > > further on, there is this piece of code:
> > >
> > > For Each buttoms In ThisWorkbook.ActiveSheet.Shapes
> > > buttoms.Delete
> > > Next
> > >
> > > this might be deleting the chart pictures as well? An MVP sent me a link
> > to
> > > a site showing how to delete buttons only, but haven't digged into to it
> > yet.
> > >
> > > I can send you the entire code offline if you're interested...
> > >
> > > thanks very much for your time and help.
> > >
> > > Steve
> > >
> >
> >
> >