I have an object in Excel that I would like to be pasted as a picture in another tab. The object contains various names in the very small font size ( font size is 2 ).
The piece of code responsible for copy/pasting an image of an object is below.So far, it can only paste the image with text being blurry and unreadable. However when I zoom in to the original shape the text reads fine. I need an image with resolution being high enough to be readable at 326% zoom.
Code:
Dim strMap As String
'Creating a new image
strMap = "mapGroup3" 'Name of an object
Sheets("Maps (Prov)").Select
ActiveSheet.Shapes(strMap).Copy
Sheets("Image").Select
Range("a1").Select
ActiveSheet.Pictures.Paste.Select
'Application.ScreenUpdating = True
I've attempted to use .PasteSpecial to specify the format but end up with the following error:
Run-time error '438':
Object does not support this property or method
Code for the error above:
'Creating a new image
strMap = "mapGroup3"
Sheets("Maps (Prov)").Select
ActiveSheet.Shapes(strMap).Copy
Sheets("Image").Select
Range("a1").Select
ActiveSheet.Pictures.PasteSpecial _
Format:=3, Link:=False, DisplayAsIcon:=False
Paste as picture or image always leads to only pasting the visible pixels. So the quality is optimal for the visible size.
If you needs copying exact the quality as it is in the source, then you should not using paste as but only copy/paste from clipboard:
Worksheets("Maps (Prov)").Shapes("mapGroup3").Copy
Worksheets("Image").Paste Destination:=Worksheets("Image").Range("D4")
Of course this pastes the same kind of object as it is in the source. If you really needs changing the kind of object, for example copying a range of cells and pasting this as picture (image), then there is no other way than making the source big enough before copying. The bigger the source will be the more pixels will be pasted later, the better the quality will be.
Unfortunately this is not as easy as it sounds. For example, if one wants copying a range of cells and pasting this as picture (image) in high quality, this needs making all objects in the range of cells bigger before copying. That is line height, column width, font size .... Then vice versa after copying. And grouped shapes must be ungrouped first, then resized all single group members before copying. Then vice versa after copying.
Related
I am attempting to copy a shape group which contains some charts as a high resolution picture. To achieve the high resolution, I use the options Appearance:=xlPrinter and Format:=xlBitmap.
Run-time error '1004' Application-defined or object-defined error
The code I am using to do this is below
ws.Shapes.Range(Array("Chart 1", "Chart 2")).Group.Name = "temp_group"
With ws.Shapes("temp_group")
.CopyPicture Appearance:=xlPrinter, Format:=xlBitmap
.Ungroup
End With
If I just remove the Format:=xlBitmap or change it to Format:=xlPicture, it works fine. The MSDN help shows xlBitmap as an option and I have tried just using 2 but that gives the same error.
If I try the same thing on a single chart, it works just fine.
ws.ChartObjects("Chart 1").Chart.CopyPicture Appearance:=xlPrinter, Format:=xlBitmap
What is the best way to copy multiple charts as a high resolution picture? I would like to avoid saving them because I need to copy/paste multiple groups of up to 30 charts for exporting to OneNote.
Edit:
After some additional testing, it turns out that I can use xlBitmap if the appearance option is set to xlScreen instead of xlPrinter. However, the resolution is still pretty terrible. This is very frustrating since just copy/pasting these same charts manually gives very nice clear pictures but for some reason VBA just ruins it. VBA is required though since this would be a very time consuming process otherwise.
shape.copypicture work's fine in excel 2016. The error is in office 360.
I was facing the same problem in my app. Here is the solution:
If you want to copy an object of type MsoShapeType.msoChart or MsoShapeType.msoPicture do this trick:
shape.ScaleHeight(2.5f, MsoTriState.msoFalse);
shape.ScaleWidth(2.5f, MsoTriState.msoFalse);
shape.Copy();
shape.CopyPicture(Excel.XlPictureAppearance.xlScreen, Excel.XlCopyPictureFormat.xlPicture);
shape.ScaleHeight(0.4f, MsoTriState.msoFalse);
shape.ScaleWidth(0.4f, MsoTriState.msoFalse);
where shape is of course your object.
First, you need to scale up the object (scaling is loseless up to orginal size of the image or maximum size of the chart, which is just 400% zooming). Then, you use CopyPicture() method with mentioned parameters, preceed with Copy()*.The last thing to do is to scale down (or not, if you won't save this sheet) the object.
*Copy() is used here to eliminate common and random error
System.Runtime.InteropServices.COMException (0x800A03EC): CopyPicture method of range class failed
If you open any Excel sheet, you will see some copy configurations:
link, because I can't add images yet
Common copy is just (xlScreen, xlBitmap);
Good quality copy is xlScreen, xlPicture) and, depending on installed printer driver, (xlPrinter) and (xlPrinter, xlPicture);
I have made a code that creates labels and barcodes for printing.
Due to other reasons (for simplicity) I have placed some labels on a separate sheet that I then need to transfer to the real sheet.
I found some mention about the CopyObjectsWithCells but it's not working for me.
Application.CopyObjectsWithCells = True
Sheets("Robot").Range("A1:L" & Lastrow).Copy
Sheets("Etikett").Range("A" & intRad).PasteSpecial Paste:=xlPasteAll
I get the same result Range().Select then Selection.Copy.
Sheets("Robot").Shapes.SelectAll
Selection.Copy
Works. But it makes the pasted image one large image, not x small images/shapes. and gives a white background overlaying the other text on the sheet.
If I select the range in Excel and press Ctrl + C / V it copies the images as I want.
But with VBA it just won't work.
Example image
Whenever you have a problem, which is can be described with:
I have managed to do it manually in Excel, but I cannot find the correct VBA code.
a good solution is to use the macro-recorder option in VBA and see the code it generates, while you do the manual work in Excel. In your case, this is the code it makes, when it simply copies two shapes to another worksheet:
Sub Makro2()
ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select
ActiveSheet.Shapes.Range(Array("Rectangle 1", "Rectangle 2")).Select
Sheets("Tabelle2").Select
Range("B4").Select
ActiveSheet.Paste
Range("M25").Select
End Sub
This code is really bad, but it works and it may give you good insights to work further.
After selecting and copying the range that contains the shapes, select the destination cell and then use ActiveSheet.Paste.
The option you are using PasteSpecial Paste:=xlPasteAll won't paste Shapes.
I have an Excel Sheet with some macros. Also, I have some navigation shapes and images on my sheet. I want users of this sheet, cannot change this shapes and images positions, can't select them and can't move them.
Is there any way to Protect some specific objects?
Regards.
I believe this is an age old question ever since Shapes were added to MS Excel and the answer to which I myself was looking for many years already.
I just found out 3 days ago, on my own, how to lock MS Excel Freeform shapes like Choropleth Map shapes from being moved around, reformatted or worst, deleted, all WITHOUT needing to lock the WorkSheet, or eventually the WorkBook.
And I think I must share my discovery with the world because everyone wants to lock their Shapes!
Steps: (I work with Excel VBA and with msoFreeform shapes mostly but I think any shape should be working and manually added shapes through Excel UI should work too and in other Office Apps as well)
1.(yourWorkSheet or )ActiveSheet.Shapes.AddChart (through VBA but MAYBE you can add chart through Excel UI and then delete the only chart)
(no need for any other parameter because we just need the chart container, "ChartObject")
2.If you don't have some already, create a shape either through Excel UI or through VBA with AddShape method or BuildFreeform on the Chart directly or on to the worksheet.
3.Copy/Paste the created shape (if created through Excel UI or through VBA on the worksheet) on to the BLANK Chart Container. (NOT drag and drop)
4.Format the ChartContainer Rectangle window as required (try "No Fill & No Outline") through VBA or Excel UI
5.There are 3 options regarding protection of a Chart
(Embedded chart here because I don't work with Chart Sheets, may be this might work with them)
source:[https://peltiertech.com/Excel/ChartsHowTo/ChartProtection.html]
But here, only the relevant 2 will be shown:
5(a)ActiveChart.ProtectFormatting = True
That protection will block any formatting changes on the Shape and the Chart via "Chart Tools Menu" or "Drawing Tools - Format Menu" or moving or resizing with mouse or deleting BUT will show the ChartContainer window upon Selection via Mouse but non-selectable via VBA
eg. yourworksheet.ChartObjects("YourChartName").Chart.ProtectFormatting=True
5(b)ActiveChart.ProtectSelection = True
That will stop the shape or the chart from being selected altogether so this is the end of story
eg. yourworksheet.ChartObjects("YourChartName").Chart.ProtectSelection=True
The best thing about this method is that the shape can still be accessible through VBA like
eg.yourworksheet.ChartObjects("YourChartName").Chart.Shapes("YourShapeName or Index").whatever
except Shape.Select which should be obvious and there is NO need to lock the Worksheet or Workbook at all.
NB:1)The interesting finding here is that the 2 protections do not replace each other (if applied one after another) but more like stacked with each other meaning if both (if you really want) were set True first and then after setting either one False, the other restriction still remains.
2)Even if selection is protected as above, the chart can still be accessible through the Selection Pane, therefore:
Application.CommandBars("Selection and Visibility").Enabled = False
and also blocking the Worksheet Export are advisable but I think these are overkill nonetheless included for completeness' sake.
Discovered and tested on MS Excel 2010 so YMMV.
Nay Lynn's answer caused my Excel to crash. Specifically with the .ProtectSelection property being enabled (using Microsoft365 Excel). . . Excel VBA's Intellisense shows the property, so it is legitimate, but everything would be fine until the chart was selected. Playing around with this idea though, I did find a great work around.
1. Place a Chart on your sheet. Make it span across the area you want to protect
(we will expand the size of this chart later).
a. Leave Fill of Chart at Default until a later step (this helps ensure the
next steps are successful).
b. Delete all the elements present for the chart (Series label, Title, Etc.)
c. Shrink the "Plot Area" box leftover to as negligible as possible.
d. CRITICAL: Right Click the chart and choose "Select Data" - use the
option to remove all the data in the boxes of this dialog, otherwise when
you select the Rectangle added below, it will show the data references as
selections in the Worksheet behind it.
2. Insert a Rectangle into the Chart. It will have the default colors.
3. Tap `Esc` to clear the selection. If you select the shape and try to move it
around, it will take precedence over the Chart itself (this is how we'll trick
Excel later).
a. Confirm this does not allow the shape to be pulled beyond the border of the
Chart.
4. Set Fill of Chart to be "No Fill"
5. Expand the Rectangle's size to match the size of the chart.
6. Set Fill of Rectangle to be a color with 100% Transparency (NOT the same as "No
Fill" - this is critical)
a. You should be able to see all of your shapes, etc, but not touch them if you
click where the rectangle was, and trying to click and drag will also fail since the
Rectangle takes selection precedence and is also bound by the chart.
7. Set the fill of the Rectangle back to a color with 0 transparency (we need to
find the edge of the shape)
8. Select the Rectangle's border and it should then select the Chart instead (you
should see the chart Format option appear).
9. Expand the Chart's border to the ends of the Excel Sheet (ensure the top left
corner sits in the top left corner of the sheet by dragging it). You can also set
the height/width to an absurd number that users will get fed up with trying to find
if you do not wish to expand it across the entire boundaries (or if there's a hard
limitation - I did not try to expand across the entire sheet, but went to "BO400"
with no issue.
a. Expand the Rectangle to fit the Chart once again if it did not expand
automatically (in my case it did, but I cannot guarantee this behavior)
b. If you have any Buttons that DO need to be clicked, place this chart
at the bottom, place all the buttons/shapes etc. that need interaction to
the top, then bring the chart up a level until all the items needing
protection are hidden.
c. Change the Transparency back to 100%
10. After you have the Chart expanded properly, you will need to use a bit of VBA
to ensure the Chart's Formatting is protected as Nay Lynn mentions. Get the
Chart's name by selecting the border, and institute some VBA Code that gets
toggled based on your needs (you might want to include an unprotect sub
as well just in case).
Example:
Sub Protect_Sheet_With_Chart ()
dim sht as Worksheet
dim chrt as Chart
Set sht = ActiveSheet
'You can use a sheet by name for the above as well - make your code robust.
Set chrt = sht.ChartObjects("ChartNameFoundFromStep10").Chart
chrt.ProtectFormatting = True
End Sub
Sub UnProtect_Sheet_With_Chart ()
dim sht as Worksheet
dim chrt as Chart
Set sht = ActiveSheet
'You can use a sheet by name for the above as well - make your code robust.
Set chrt = sht.ChartObjects("ChartNameFoundFromStep10").Chart
chrt.ProtectFormatting = False
End Sub
11. After you protect the Chart, selecting it and deleting will not
actually delete it, NOR the rectangle, so it can't be removed!
12. Protect your code somehow and you'll be set!
I encountered this weird phenonemon when copying shapes with VBA, and I don't know how to deal with this:
When Cells and Shapes are copied using the regular .Copy function, the shapes are slighty compressed in the height direction. Their placement seems right, more or less.
I use VBA 7.0 with Excel 2010.
I sincerely hope someone can help me with this. I spend quite some time finding info on this subject!
Code:
Sub RenderOverview()
' Clear Worksheet
Sheets("ModelOverzicht").Cells.Clear
Sheets("ModelOverzicht").DrawingObjects.Delete
' Copy SINGLE SECTION
Sheets("Enkele Sectie").Range("A1:AM29").Copy
Sheets("ModelOverzicht").Select
Range("A1").Select
ActiveSheet.Paste
End Sub
I came here, because I had the same problem and the answer of "user1759942" didn't solve my problem. After a little bit investigation I was able to nail down the cause of the change in size of my chart.
My origin worksheet (where I copy said chart) had a zoom of 80%, while my destination worksheet (where I paste copied chart) had no zoom (100%).
After changing both worksheets to the same zoom value (80%) and activating the destination worksheet right before pasting the copied chart, the problem was gone. I didn't even need to change the "Format Shape" - Properties - "move but dont size" like suggested by "user1759942" (by the way: this is done in VBA/VBscript by setting: [Worksheet].ChartObjects(1).Placement = xlMove ' xlMove = &H2).
Perhaps this is an answer to question of "user3250519".
this is because the shapes are tied to the cells By default. So if a cell's height / width is changed, so will the shapes height / width. Right click "Format Shape" - Properties - "move but dont size" will keep the shapes spot, but will not change the size. Try it out. you may have to resort to savign the height of the rows / shapes before pasting and apply that after pasting
--
Edit
When copying and pasting, cells heights / widths are changed to I think the height and width of the range they are being pasted to. You could also change the height and width of the target range, to match the source range, before pasting.
I have a series of images that I need to display multiple times on both forms (via image controls) and on worksheets (via activeX image controls). I know that I could keep the files externally and use the loadpicture method; but there is something I want to avoid if possible.
I also know I could save and load- but again I would rather not use an external file write to perform the task. Ideally, everything will stay embedded and hidden within the file itself.
I think there maybe a solution in using the clipboard- but I couldn't get the syntax to work. The object is embedded always in the same location(s); it never moves or changes size or other properties (beyond .visible). So what I would really like to do is something simple like;
Sheet1.oleobjects("toImage").object.picture = frm1.fromImage.picture
**Edit: **
I think I've found a solution to this; but still have a related question.
I worked out that I could do what I want if I embed a series of activeX images on a sheet; then reference them in the actual controls / objects I want. So;
Sheet1.oleobjects("toImage").object.picture=Sheet1.oleobjects("FromImage").object.picture
or
frm1.Controls("toImage").picture = Sheet1.oleobjects("FromImage").object.picture
But, the below doesn't work when I try to do the same using an inserted picture (a shape object);
frm1.toImage.picture = sheet1.shape("FromImage").picture
..isn't valid syntax. It seems the only thing I can do with them is copy them- I couldn't use them to set the picture of another object without using the clipboard.
The solution above works for me (using a series of activeX image objects rather than pictures)- but I am curious why I can't do with using a standard picture (shape).
If you want to add a picture to your Excel sheet use something like this:
(You can change ActiveSheet to your favorite sheet)
Dim aSheet As Worksheet
Dim aShape As Shape
Set aSheet = ActiveSheet
Set aShape = aSheet.Shapes.AddPicture("<FileName>", msoFalse, msoTrue, 120, 120, 200, 200)
And for more details :
Function AddPicture(Filename As String, LinkToFile As MsoTriState, SaveWithDocument As MsoTriState, Left As Single, Top As Single, Width As Single, Height As Single) As Shape
Function AddPicture2(Filename As String, LinkToFile As MsoTriState, SaveWithDocument As MsoTriState, Left As Single, Top As Single, Width As Single, Height As Single, Compress As MsoPictureCompress) As Shape
And if you want to load a picture to your Image component on your form :
(Add an Image component to your form [: Image1])
Set Image1.Picture = LoadPicture("<FileName>")