I have a tangential question to this one: Using VBA Code how to export excel worksheets as image in Excel 2003?
Specifically, when the macro pastes the copy of the range to the chart, the image is blank, even though the copied range contains 5 charts and some formatted cells. When I perform the exact same steps manually it all works as expected.
Even weirder, I've recorded the whole process except the export step. When I run the recorded macro, it works. But when I copy the code from the recorded macro inside the For Each loop below, and tweak it to point to the sheet being worked by the macro (i.e. replacing "ActiveSheet" with "t") the macro doesn't work again.
I even went so far as to just invoke the recorded macro after using the For Each to move to each sheet, still getting a blank image pasted.
I'd appreciate any help on this.
My code:
Sub ExportCharts()
Dim Rng As Range
Dim S As Worksheet
Dim wb As Workbook
Set wb = ThisWorkbook
Dim EName As String
Dim CO As ChartObject
Dim C As Chart
Dim temp As String
Application.ScreenUpdating = False
'Iterate through the sheets in the workbook
For Each t In wb.Worksheets
'Capture the sheet
Set S = t
S.Activate
'Set the range to be exported
Set Rng = S.Range("A1:Z60")
'Copy range as picture onto Clipboard
Rng.Select
Rng.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
'Build the chart/file name
EName = S.Name & " Quality Charts"
'Create an empty chart with exact size of range to be copied
S.Range("$AA$1:$AC$2").Select
ActiveSheet.Shapes.AddChart.Select
Set C = ActiveChart
temp = Right(C.Name, Len(C.Name) - 1 - Len(S.Name))
S.Shapes(temp).Height = Rng.Height
S.Shapes(temp).Width = Rng.Width
'Paste into chart area, export to file, delete chart
'C.Activate
With C
.Paste
.Export "\\COMPUTERNAME\Users\USERNAME\Desktop\My Documents\" & EName & ".jpg"
'Note the above is an actual hard coded path in my code (yes I want it hard coded)
End With
C.Delete
Next
Application.ScreenUpdating = True
End Sub
So I finally figured out the issue. The line turning off screen updating is the issue.
One would assume that's because I say copy as it appears on the screen (why MS didn't just allow for that command to use the display as it appeared at the last screen update is beyond me, but it's not exactly like Excel is bug free).
In any event, commenting out that line results in a good paste.
As a note for those who have more going on in there macros and want/need screen updates off in order to get a reasonable run speed, after I figured out the problem I tried reactivating screen updates before the copy as picture, then turning it off again immediately afterwards, and that worked.
Related
I am writing a chart formatting Excel add-in for my office.
To handle both embedded charts and chart sheets I wrote two loops in the first subroutine. Each time a chart is activated, a second subroutine is called to handle ActiveChart formatting.
Part of my goal is to apply data labels to line charts, however my code produces blank data labels as in figure 1 even when I have set DataLabel.ShowSeriesName = True. There are two cases where the labels are added correctly described below.
Option Explicit
Sub CESAR_style ()
Dim a as application
Dim wb As Workbook
Dim ws As Worksheet
Dim chtO As ChartObject
Dim cht As Chart
Set twb = ThisWorkbook
Set a = Application
' Turn off events
a.EnableEvents = False
' Loop through all chart sheets
For Each cht In a.Charts
cht.Activate
Call Format
Next
' Loop through all chart objects
For Each ws In ActiveWorkbook.Worksheets
For Each chtO In ws.ChartObjects
chtO.Activate
Call Format
Next
Next
a.EnableEvents = True
End Sub
Private Sub Format()
Dim i As Integer
Dim j As Integer
With ActiveChart
' Count the series in the chart
i = .SeriesCollection.Count
' Code here to add a new series used to make a 'Today' _
reference line dividing history and future
' Add series data labels, excluding the new series added above
' For each data series
For j = 1 To i
With .FullSeriesCollection(j)
' For Line charts
If .ChartType = xlLine Then
' Turn off leader lines for full series
.HasLeaderLines = False
' Add series data label to right of last point in series
With .Points(.Points.Count)
' If a label already exists remove it
If .HasDataLabel = True Then
.HasDataLabel = False
Else
End If
The code works properly to this point, but when .ApplyDataLabels runs, it creates blank data labels as seen in figure 1 [blank data labels]1
' Add a series data label
.ApplyDataLabels ShowSeriesName:=True, _
ShowValue:=False, _
HasLeaderLines:=False
End With
Else
' Code here to handle stacked area charts; working properly
End If
End With
Next
End With
End Sub
I have added a break point at .ApplyDataLabels. If I continue the code with F5 or the play button, it continues to give me blank labels. However, if i step the code with F8 or Step Into, the code executes successfully and I get the labels I want as seen in figure 2.
Correct data labels
A second confusing quality is when I move the .ApplyDataLabels segment to the CESAR_style subroutine, the code runs successfully.
I have tried delaying the code with sleep but without success.
Is there something I'm doing wrong in how I've set up the two subroutines?
Any help or insight is much appreciated. Let me know if additional information is needed to make the problem clearer.
Generally with VBA I find that if something works when you're stepping through it, but not when you're running it, it's a select/focus problem. When you're stepping through the code, you're likely selecting the worksheet the the chart is on so you can see what your code is doing, which is effectively doing a step for your macro. Try activating the worksheet the chart is on before activating the chart. If that doesn't work, try selecting a cell on the worksheet instead.
I was wondering if it's possible to move an image from one worksheet to another (in the same workbook) without having to select cells. My current solution (obviously using copy and paste) is as follows:
ThisWorkbook.Worksheets("Assets").Shapes("logo").Cut 'Destination:=Worksheets("test").Range("$A$1")
ThisWorkbook.Worksheets("test").Activate
ActiveSheet.Range("$A1").Select
ActiveSheet.Pictures.Paste
Specifying a 'Desitation' parameter doesn't seem to work.
Hi I did this recently where I had a number of pics on one sheet needed to find the correct one then insert it on another sheet. I did it this way without selecting any cells.
Dim teamShape As Shape
Dim reportSheet As Worksheet: Set reportSheet = Sheets("Iteration Report")
Dim picSheet As Worksheet: Set picSheet = Sheets("Pics")
For Each teamShape In picSheet.Shapes
If teamShape.AlternativeText = PicName Then
teamShape.CopyPicture
reportSheet.Range("h27").PasteSpecial
Selection.ShapeRange.IncrementLeft 175.937480315
Selection.ShapeRange.IncrementTop -4.687480315
Selection.ShapeRange.Width = 300
Exit For
End If
Next teamShape
Good luck
You were not so far from functional in your initial code. You could cut and paste without selecting like this:
Sub CutPaste()
ThisWorkbook.Worksheets("Assets").Shapes("logo").Cut
ThisWorkbook.Worksheets("Test").Range("A1").PasteSpecial
End Sub
So I have this code:
Sub CopyItems()
Dim Source As String
Dim Target As String
'Dim SourceSheet As String
'Dim TargetSheet As String
Source = "Source.xlsm"
Target = "needChange.xlsm"
'SourceSheet = "Sprint backlog"
'TargetSheet = "Sheet1"
Workbooks(Source).Sheets("Sprint backlog").Range("B6:B15").Copy
Workbooks(Target).Sheets("Sheet1").Range("A14:A23").Paste '<-ERROR here
End Sub
And it's giving me the Run-time error '9' as expressed in the title. The code is so simple that I am completely stumped.
I read around the net and it seems it's because of names that don't exist, however both the sheets and workbooks exist, with identical names. There is no space or weird char between any of the code.
Basically I want to Copy a column ranging from B6 to B15 from the sheet "Sprint backlog" in Source.xlsm to the range A14 to A23 in Sheet1 of needChange.xlsm
I tried, without any luck:
Workbooks(Source).Sheets("Sprint backlog").Range("B6:B15").Copy _
Workbooks(Target).Sheets("Sheet1").Range("A14:A23").PasteSpecial
And also modified code with what's now commented out.
I suspect the Macro can't access the target file (needChange.xlsm) because it can't find it or can't access it and therefore return the problem, but i cannot figure out how to fix it with code..
If it helps, while running the macro, both of the Workbooks in this code were open and accessible for me.
I am turning to you for help.
Big thanks.
Best Regards.
This was trickier than expected. I borrowed heavily from this web page http://ccm.net/faq/24666-excel-vba-copy-data-to-another-workbook.
I had to add references to the sheets for the copy and paste to get it to work.
The code as posted requires both workbooks to be open, but you can have wbTarget get opened if you give it a pathname. In that case you could comment out the two lines that appear after the -OR-.
The code can also save and close the target workbook as well.
Sub CopyOpenItems()
'
' CopyOpenItems Macro
' Copy open items to sheet.
'
' Keyboard Shortcut: Ctrl+Shift+O
'
Dim wbTarget As Workbook 'workbook where the data is to be pasted
Dim wbThis As Workbook 'workbook from where the data is to copied
Dim strName As String 'name of the source sheet/ target workbook
'set to the current active workbook (the source book)
Set wbThis = ActiveWorkbook
'get the active sheetname of the book
strName = ActiveSheet.Name
'open a workbook that has same name as the sheet name
'Set wbTarget = Workbooks.Open("C:\YourPath\needChange.xlsm")
' - OR -
Workbooks("needChange.xlsm").Activate
Set wbTarget = ActiveWorkbook
'select cell A1 on the target book
'wbTarget.Range("A1").Select
'clear existing values form target book
'wbTarget.Range("A1:M51").ClearContents
'activate the source book
wbThis.Activate
'clear any thing on clipboard to maximize available memory
Application.CutCopyMode = False
'copy the range from source book
wbThis.Sheets("Sprint backlog").Range("B6:B15").Copy
'paste the data on the target book
wbTarget.Sheets("Sheet1").Range("A14").PasteSpecial
'clear any thing on clipboard to maximize available memory
Application.CutCopyMode = False
'save the target book
'wbTarget.Save
'close the workbook
'wbTarget.Close
'activate the source book again
wbThis.Activate
'clear memory
Set wbTarget = Nothing
Set wbThis = Nothing
End Sub
if you copy only values (and no formula, picture, formating), a simple
Workbooks(Target).Sheets("Sheet1").Range("A14:A23").value = Workbooks(Source).Sheets("Sprint backlog").Range("B6:B15").value is good.
(in one same code line, only the size of the window here makes it look beeing on 2).
for more than values :
Workbooks(Source).Sheets("Sprint backlog").Range("B6:B15").Copy _
Workbooks(Target).Sheets("Sheet1").Range("A14:A23").
(in 2 lines)
note : the _ means that the folowing line is meant to be on the same line , and is only there for reading the code more easily purpose . (you made that error in your second code)
note 2 : range().paste does not exist , only sheets().paste , or range().pastespecial.
note 3 : of course, all worbooks, and sheets, must exist and have the same exact name than those used...
note 4 : copy/paste works ONLY if both workbooks are already opened. for closed files it's a different story.
To make it short, you made 2 mistakes : _, and range().paste.
I have a worksheet that is copied and pasted into a new worksheet when the user clicks on a button. I've managed to copy everything in the worksheet (shapes, buttons, etc.) except for the combo boxes that contain dropdown lists using named ranges (which are created with the following code: http://www.contextures.com/xlDataVal11.html).
I tried to record a macro for this and got the following (simplified)
ActiveSheet.Shapes.Range(Array("ExampleCombo")).Select
Selection.Copy
ActiveSheet.Paste
With this I understood that the combo box is regarded as a shape. In order to copy all combo boxes and put them in the right position in the new sheet I therefore tried the following:
Sub CopyCombos ()
Dim ws_new As Worksheet
Dim ws_old As Worksheet
Dim Special_Shape As Shape
Dim Special_Shape_COPY As Shape
Dim Position_Left As Single
Dim Position_Top As Single
Dim Position_Width As Single
Dim Position_Height As Single
Set ws_old = ActiveSheet
ActiveWorkbook.Worksheets.Add
Set ws_new = ActiveSheet
For Each Special_Shape In ws_old.Shapes
'Copy position
Position_Left = Special_Shape.Left
Position_Top = Special_Shape.Top
Position_Width = Special_Shape.Width
Position_Height = Special_Shape.Height
'Copy
Special_Shape.Copy
'Paste
ws_new.Paste '<=== Here's the problem! But why?
'Rename
Set Special_Shape_COPY = Selection
'Put in right place
Special_Shape_COPY.Left = Position_Left
Special_Shape_COPY.Top = Position_Top
Special_Shape_COPY.Width = Position_Width
Special_Shape_COPY.Height = Position_Height
Next Special_Shape
End Sub
I get an error message saying "Can't enter break mode at this time" directly after pasting the combo box in the new worksheet. How can I solve this?
Rather than:
Set ws_old = ActiveSheet
ActiveWorkbook.Worksheets.Add
Set ws_new = ActiveSheet
and doing copies, use:
ActiveSheet.Copy After:=Sheets(Sheets.Count)
This will produce a complete copy:
rows
cells
Objects, etc.
The answer of Gary's Student to copy the worksheet worked just fine when copying it within the same workbook:
ActiveSheet.Copy After:=Sheets(Sheets.Count)
However this causes a problem when copying the sheet to another (new) workbook as the format differs in colors. To solve this I used the following code before adding a new workbook:
Workbooks.Add Template:="Workbook"
I'm a very new, self-taught programmer, so please keep this in mind in your responses. I have extensively searched this and other forums and can't seem to find a similar question.
The following code has been working for weeks and has not been changed. (My macro includes more variables and code, but I know from taking it apart that those pieces work, so I've left them out for clarity). From what I can tell the PasteSpecial function is specifically not working.
Dim StimSheet As String
ActiveCell.Rows("1:290").EntireRow.Select
Selection.Copy
'Copies the data for the current stimulus
StimSheet = Application.InputBox("Enter the name of the stimulus")
'asks name of the stimulus
Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = StimSheet
'adds new sheet at the end and names whatever you input as stimulus name
Sheets(StimSheet).Select
Selection.PasteSpecial Paste:=xlPasteValues
'pastes data into new sheet
At this point there is no error, the macro simply stops after copying and creating the new sheet.
Here's what I know / have tried:
The macro is successfully making and naming the new sheet and copying the selection to the clipboard, because I can manually paste it after running the macro. It seems to be getting stuck at the paste piece.
Other macros that use the exact same format of copy / paste special are still working correctly.
Another forum with a similar program suggested typing "Application.EnableEvents=True" into the immediate window. This did not change anything.
This macro has worked for several weeks with no errors. I have made new macros using previously saved code in case something inadvertently was changed in the current one, but this did not work either.
The paste option will work one time on a new file and then ceases to work again.
Thank you in advance for your suggestions.
You might find the problem is that you don't have much control over which workbook and worksheet this code applies to. It's better to avoid ActiveSheet, Select, and Sheet with no parent as much as you can.
If you only need to copy the values of cells without any formatting, then Paste isn't needed either.
Try changing your code to the following and see if you have any better luck:
Const BOOK_NAME As String = "Book1.xlsm" 'change this to your workbook name
Const SOURCE_SHEET_NAME As String = "Sheet1" 'change this to your sheet name
Dim wb As Workbook
Dim sourceSheet As Worksheet
Dim newSheet As Worksheet
Dim newSheetName As String
Dim validName As Boolean
Dim rng As Range
' Set the book, sheet and range objects
Set wb = Workbooks(BOOK_NAME)
Set sourceSheet = wb.Worksheets(SOURCE_SHEET_NAME)
Set newSheet = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))
' Acquire the new sheet name and check it's valid.
Do
newSheetName = InputBox("Enter the name of the stimulus")
On Error Resume Next
newSheet.Name = newSheetName
validName = (Err.Number = 0)
On Error GoTo 0
If Not validName Then MsgBox "Sheet name isn't valid. Try again."
Loop Until validName
' Write the values into the new sheet
Set rng = sourceSheet.Cells(1, 1).Resize(290, sourceSheet.UsedRange.Columns.Count)
newSheet.Range(rng.Address).value = rng.Value2
I moved this line:
StimSheet = Application.InputBox("Enter the name of the stimulus")
to the top of the method and it seems to work reliably. I wish I could tell you exactly why, but at least you can proceed. Perhaps it has something to do with the focus changing.
Also, when it failed for me (Office 2013) I got the following error:
Run-time error 1004:
Application-defined or object-defined error.
When the Sub was in a Sheet code behind, and this:
Run-time error '1004'
PasteSpecial method of Range class failed.
When pasted in a Module.