I have a workbook with many sheets and images that have random names and arbitrary order, the only image that I need is always in the range A2:C14, I'm using the following code to copy the image:
firstSheet.Range("A2:C14").Copy
secondSheet.Range("I6").PasteSpecial
But it only copies the cell text, not the image.
Is there a way to copy an image using Range("A2:C14)" or another way to select the cell to copy the image?
Since CopyPicture is a method of a Shape object, unless you already have a pointer to it, using the Shapes collection is unavoidable
Something like this
Sub Demo()
Dim shp As Shape
Dim rng As Range
Set rng = firstSheet.Range("A2:C14")
For Each shp In firstSheet.Shapes
If Not Intersect(rng, shp.TopLeftCell) Is Nothing Then
' Found it
shp.CopyPicture
secondSheet.Range("I6").PasteSpecial
Exit Sub
End If
Next
End Sub
Related
I want to delete one picture msword using macro
The sample code is below, I am new with but not working
Dim myImage As Shape
Set myImage = ActiveSheet.Shapes("Picture 1")
myImage.Delete
ActiveSheet is Excel, not Word. You would use ActiveDocument for Word and your picture may either be a Shape or an InlineShape depending on whether it has text wrapping or not.
Sub DeletePicture()
ActiveDocument.Shapes("Picture 1").Delete
ActiveDocument.InlineShapes(1).Delete
End Sub
I want to change the data of a chart in a Word Document, but I can't find the right way to address my charts. I tried several techniques, but nothing worked. (I´d love to open a ExcelSheet in which I can just change the Data)
So to put it all together: I want to change the data (not the source), of a MS Word chart, which looks like that:
Edit(13.8.):
After request, I try to give you some "reference Code" to work with.
Sub ChangeChart()
Dim aktDocument As Document
Dim chrt As Chart
Dim SourceSheet As Excel.Worksheet
Set aktDocument = ActiveDocument
Set SourceSheet = aktDocument.Shapes(1).Chart.OpenSourceData 'I know it´s not that easy
SourceSheet.Range("B5") = newStuff
aktDocument.Shapes(1).Chart.SetSourceData = SourceSheet
End Sub
I know this may sounds utopic and ridiculous, but I just don´t know, how to address the chart in the right way, or to even work with it properly.
Edit(15.08):
Even after recreating the old charts, the following code is not able to find a shape which has a chart. And therefore it stops when the index is out of range.
Sub Test()
i = 0
Do While i < 100
i = i + 1
If ActiveDocument.Shapes(i).HasChart Then
MsgBox "found one!"
End If
Loop
End Sub
Solution(30.08.):
The answer from #Cindy Meister was the solution to my problem. After further working with it, I came to the problem, that the ChartData always opens on the screen, while running the code.
Just for reference this question was my workaround.
All Office applications use the Excel engine to create and manage charts. In Word, charts can be formatted in-line with the text or with text wrap formatting. In the former case, a chart object needs to be addressed via the InlineShapes collection, in the latter via the Shapes collection.
Since your sample code uses Shapes(1) I've used that in the code snippet below. If it's not certain that the first Shape in the document is the chart, but you've assigned the Shape a name, you can use that as the index value (for example Shapes("MyChart"). Or you can loop the Shapes collection and check HasChart.
HasChart returns True if the Shape (or InlineShape) is a Chart. It's then possible to set Shape.Chart to an object variable. The chart's data can be accessed using Chart.ChartData.Activate - if you don't use Activate it's not possible to access the data when the chart's worksheet is stored in the Word document. Only then can Chart.ChartData.Workbook return a workbook object, and through that the worksheet can be accessed using ActiveSheet. From that point on, it's like working with the Excel object model.
Sub ChangeChart()
Dim aktDocument As Document
Dim shp As Word.Shape
Dim chrt As Word.Chart
Dim wb As Excel.Workbook, SourceSheet As Excel.Worksheet
Set aktDocument = ActiveDocument
Set shp = aktDocument.Shapes(1)
If shp.HasChart Then
Set chrt = shp.Chart
chrt.ChartData.Activate
Set wb = chrt.ChartData.Workbook
Set SourceSheet = wb.ActiveSheet
SourceSheet.Range("B5").Value2 = newData
End If
End Sub
I've searched through out Google and on here for a proper answer and I can't seem to find one...
I have an image on "Sheet2" that I want to copy over to "Sheet1", the image's name is static and doesn't change. I've got the below code to delete the already existing image on "Sheet1" and now I need it to be replaced with the image from "Sheet2"
Sub CheckImageName()
For Each shape In ActiveSheet.Shapes
If Not Intersect(shape.TopLeftCell, Range("L77:AM97")) Is Nothing Then
shape.Delete
End If
Next shape
End Sub
Every method I saw was using .Select and pasting into the area, however I'm really trying to avoid using the .Select and .Paste methods as I've read all over SO and other sources that it's best to avoid using .Select.
I found a response for Word that could apply for your question.
Copy shape in Word 2010 without .Select?
Sub createShape()
Set myshape = ActiveDocument.Shapes.AddShape(msoShapeRectangle, 100, 100, 100, 100)
Set anothershape = myshape.Duplicate
End Sub
So I have a sheet with some pictures. All of these are just a copy paste of the original picture so they all have the same name "Flower".
I want to select all of them and flip them. But it will only select the original, how do I get past this? I tried incorporating a loop as well, without luck.
Sub Test()
ActiveSheet.Shapes.Range(Array("Flower")).Select
Selection.ShapeRange.Flip msoFlipHorizontal
End Sub
I know that I could simply rename them to Flower1, Flower2 etc. but the plan is to use this for a lot of pictures, so it would take to long to change manually. If it could all be done with a loop, that would be fine, but then I would still have the same problem as above.
You can loop thru the collection Shapes looking for the shapes with the given name. Try this.
Sub Test()
Dim Pic As Shape
For Each Pic In ActiveSheet.Shapes
If Pic.Name = "Flower" Then Pic.Flip msoFlipHorizontal
Next Pic
End Sub
In addition, you can code this without selecting it. Faster and more reliable.
There are two objects in VBA that could be useful - the shape collection named Shapes and the Shape itself. Thus, you can loop through the collection like this:
Sub Test()
Dim shShape As Shape
Dim shCollection As Shapes
Set shCollection = ActiveSheet.Shapes
For Each shShape In shCollection
shShape.Flip msoFlipHorizontal
Next shShape
End Sub
I have a list of more than 150 cells which contained hyperlinks to images on local hard,
yesterday I found a way to popup those images by inserting comments with filling the background with a picture.
It will be tough to do this one by one, So I want a VBA script to insert comments on selected cells and fill the comments background with images which its hyperlink located in every cell.
Is That possible or should I do it manually?
Here is an Example of cells contents
I1 D:\My Pictures\example 001.jpg
I2 D:\My Pictures\example 021.jpg
I3 D:\My Pictures\example 030.jpg
Recording a macro shows that the above is possible. A little tweaking is in order, though. As an example, the following macro creates an image pop-up via comment for A1.
Sub Test()
Dim Comm As Comment
On Error Resume Next
Range("A1").AddComment
Range("A1").Comment.Visible = False
Set Comm = Range("A1").Comment
Comm.Shape.Fill.UserTextured "C:\foo\bar.gif"
End Sub
The On Error Resume Next is for handling ranges that already have comments, so you can keep on running the macro repeatedly. I set .Visible to False to be safe that the images don't become permanent pop-ups (should only appear on hover).
We can tweak the above further to create a subroutine that takes in a range and a string as arguments so we can call it repeatedly across ranges.
Sub CreatePopUp(TargetRange As Range, PathToImage As String)
Dim Comm As Comment
On Error Resume Next
With TargetRange
.AddComment
.Comment.Visible = False
Set Comm = .Comment
End With
Comm.Shape.Fill.UserTextured PathToImage
End Sub
The above can be called like so:
Sub MassPopUp()
Dim rCell As Range
For Each rCell In [A1:A10]
CreatePopUp rCell, "Blah"
Next
End Sub
Let us know if this helps.
EDIT:
If your date is in, for example, I1:I10, and they contain the exact paths to the image files, then the above can be written like so:
Sub MassPopUp()
Dim rCell As Range
For Each rCell In [I1:I10]
CreatePopUp rCell, rCell.Value
Next
End Sub
rCell.Value will take the value inside the cell, pass it to the subroutine that inserts an image, and apply it as a comment to rCell with the proper image extracted. This should not fail. Just make sure the value in the cell are proper paths to their respective files.