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
Related
I would like to simplify updating my orgcharts in Visio. So far I have a macro borrowed from here https://bvisual.net/2010/01/28/applying-selected-datagraphic-to-the-whole-document/ and written out below. I would like to adapt it to make some changes to the format of the text withing shapes e.g. to make the font bold and potentially to change it's colour. I'm finding it really difficult to find examples of this online so any help/suggestion would be greatly appreciated.
Public Sub ApplyDataGraphicToDocument()
Dim mstDG As Visio.Master
Dim shp As Visio.Shape
Dim pag As Visio.Page
Dim firstProp As String
If Visio.ActiveWindow.Selection.Count = 0 Then
MsgBox "Please select a shape which already has data graphics"
Exit Sub
Else
Set shp = Visio.ActiveWindow.Selection.PrimaryItem
If shp.DataGraphic Is Nothing Then
MsgBox "Please select a shape which already has data graphics"
Exit Sub
Else
'Get the shapes DataGraphic master
Set mstDG = shp.DataGraphic
'Get the name of the first Shape Data row
firstProp = "Prop." & _
shp.CellsSRC(Visio.visSectionProp, 0, 0).RowNameU
End If
End If
For Each pag In Visio.ActiveDocument.Pages
If pag.Type = visTypeForeground Then
For Each shp In pag.Shapes
'Check that the named Shape Data row exists
If shp.CellExistsU(firstProp, Visio.visExistsAnywhere) Then
'Set the DataGraphic
shp.DataGraphic = mstDG
End If
Next
End If
Next
End Sub
You can modify the default OrgChart shapes, although it is not officially supported. To change the default shapes (make their font bold), you'll need to edit the templates (masters) for those OrgChart shapes. In the same blog you can find more information on customizing the OrgChart diagrams, here: https://bvisual.net/2012/05/08/creating-a-custom-org-chart-template-with-extra-properties
The procedure is mostly the same, just instead of adding the properties, you make the text bold.
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
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 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
This function works when I use it within a word macro to shrink all images to 9.3cm:
Sub ShrinkWordImages()
Dim iShp As InlineShape
For Each iShp In ActiveDocument.InlineShapes
iShp.LockAspectRatio = msoTrue
iShp.Width = CentimetersToPoints(9.3)
Next iShp
End Sub
But when I try to run it from within a powerpoint macro, referring to a word document (with all references properly in place), the images in the word document just disappear.
From powerpoint I use this, and its the only difference:
For Each iShp In wrdDoc.InlineShapes
Where wrdDoc has been properly declared and set.
Powerpoint also crashes after the macro finishes.
I tried changing iShp to variant but that didn't help.
EDIT: SO I've now established that CentimetersToPoints(9.3) is returning 0 in powerpoint, vs 263 or so in Word. Looking into that now.
There is nothing like CentimetersToPoint in PowerPoint which you call in your situation. You need to refer to your Word object variable to get the dimension. Maybe like this:
Sub CentimetersTo_Word()
Dim WRD As Object
Set WRD = CreateObject("Word.Application")
Debug.Print WRD.centimeterstopoints(10)
End Sub
So, simply add your Word Application reference before CentimetersToPoint
Just made my own method...and it worked.
Function CmToPt(pt As Single) As Single
CmToPt = pt * 28.35
End Function
Not sure why the normal one wasnt working but this did the trick.