I use the following VB.NET (VSTO) code to add a shape in MS-Word,
Dim app As Word.Application = Globals.ThisAddIn.Application
Dim doc As Word.Document = app.ActiveDocument
Dim left As Single = CSng(Convert.ToDouble(app.Selection.Information(Word.WdInformation.wdHorizontalPositionRelativeToPage)))
Dim top As Single = CSng(Convert.ToDouble(app.Selection.Information(Word.WdInformation.wdVerticalPositionRelativeToPage)))
Dim shape As Word.Shape = doc.Shapes.AddShape(1, left, top, 225.1F, 224.5F)
shape.Fill.BackColor.RGB = ColorTranslator.ToOle(Color.Transparent)
shape.Fill.Visible = Microsoft.Office.Core.MsoTriState.msoFalse
shape.Fill.Transparency = 0.0F
shape.Line.Transparency = 0.0F
shape.Line.Visible = Microsoft.Office.Core.MsoTriState.msoFalse
shape.Fill.UserPicture("C:\Newfolder\App1.jpg")
What this code does is, it adds a rectangle shape at cursor point, makes it transparent (both background and line) and adds (fills) an image.
This works fine in Word 2007. But on Word 2010 and Word 2013 there is an issue. It adds the rectangle shape at cursor point and makes it transparent. But it does not fill the image.
shape.Fill.UserPicture("C:\Newfolder\App1.jpg")
The above line of code does not work in Word 2010 and Word 2013. Other parts works fine. How to modify the code to fill the image in the rectangle shape in Word 2010 and 2013?
Instead of shape.Fill.UserPicture("C:\Newfolder\App1.jpg") try
Word.Range range = shape1.TextFrame.TextRange;
range.InlineShapes.AddPicture(#"C:\Newfolder\App1.jpg", false, true, Type.Missing);
Related
I have a little macro that adds a new sheet to a drawing intended for creating a .dxf file for the laser cut-out of sheet-metal parts.
Sub CATMain()
Dim drawingDocument1 As DrawingDocument
Set drawingDocument1 = CATIA.ActiveDocument
Dim drawingSheets1 As DrawingSheets
Set drawingSheets1 = drawingDocument1.Sheets
Dim drawingSheet1 As DrawingSheet
Set drawingSheet1 = drawingSheets1.Add("Laser")
drawingSheet1.PaperSize = catPaperA0
drawingSheet1.[Scale] = 1#
drawingSheet1.Orientation = catPaperLandscape
CATIA.StartCommand "Unfolded View"
End Sub
I'd like to make an addition to this macro where it removes the border of the sheet format.
The manual method of doing this is shown in the following screenshot:
So I either need to find a VBA command to untick that box, or a command to use Sheet Style "NoBorderTest" (as seen in the screenshot).
I couldn't find a way to do either, any help would be appreciated.
I'm trying to accomplish exactly the same thing you are, I'm making drawings that contain a view scaled 1:1 that can be exported as a DXF for 3 axis machining. The format is very annoying, it makes it difficult to see the part profile if its size is similar to the paper dimensions. The drawing format "shadow" hides the geometry.
The work around that I came up with was to set the paper height and paper width to very small numbers, 0.0000001 seemed to work fine. The paper height and paper width properties are exposed APIs that you can work with:
Dim DXFRoot As DrawingRoot = DXFRepRef.GetItem("CATDrawingAccess")
Dim DXFSheets As DrawingSheets = DXFRoot.Sheets
Dim DXFSheet As DrawingSheet = DXFSheets.ActiveSheet
DXFSheet.PaperSize = CatPaperSize.catPaperUser
DXFSheet.Scale = 1
DXFSheet.SetPaperHeight(0.0000001)
DXFSheet.SetPaperWidth(0.0000001)
Code that perfectly works in earlier versions of PPT stopped working in 2016.
When I try to change the left property of a shape in a chart, I get a Method left of object shape failed error.
I can perfectly read the .Left property.
I am running out of ideas? What can I do?
Sub test11()
Dim sld As Slide
Dim objChart As Object
Dim shpBubble As Object
Set sld = ActivePresentation.Slides("ScatterPlot01_Purch6")
Set objChart = sld.Shapes("Chart01").Chart
sld.Select
objChart.Select
Set shpBubble = objChart.Shapes("P01")
'shpBubble.Select
Debug.Print shpBubble.Left, shpBubble.Visible
shpBubble.Left = 10
End Sub
UPDATE
Having tested in PowerPoint 2010 and 2013, where it works, this now looks like a bug in 2016!
* END *
I managed to recreate the error in PowerPoint 2016 (PC) by manually adding a shape to a test chart (select the chart then click Format / Insert Shapes) and trying to write to several of it's properties including position and formatting such as changing fill colour. All generate an error.
Maybe one workaround is to use the .Delete method to delete the desired shape and then add a new shape at the required size and position. Something like this:
Sub test11()
Dim sld As Slide
Dim objChart As Chart 'Object
Dim shpBubble As Shape 'Object
Set sld = ActivePresentation.Slides("ScatterPlot01_Purch6")
Set objChart = sld.Shapes("Chart01").Chart
sld.Select
objChart.Select ' this won't work as you can only select the parent shape sld.Shapes("Chart01")
With objChart
.Shapes("P01").Delete
.Shapes.AddShape msoShapeOval, 10, 10, 20, 20
End With
End Sub
The challenge is that because the new shape is added as read only, the formatting can't be set!
I am using a small VBA script to apply some text in the background. The script works fine on PowerPoint 2007 and PowerPoint 2010.
However, in PowerPoint 2013, setting Shape.Height and Shape.Width has no effect. Here is the snippet of the code. Any help would be appreciated.
Public Sub applyWatermark()
Dim curDesign As Design
Set curDesign = ActivePresentation.Designs.Item(1)
Dim masterSlide As Master
Set masterSlide = curDesign.SlideMaster
Dim shape As shape
Set shape = masterSlide.Shapes.AddTextbox(msoShapeRectangle, 0#, 0#, 100#, 100#)
shape.TextEffect.Text = "Watermark"
' Setting height and width works fine on PPT 2010 but does not work on PPT 2013
shape.Height = 200
shape.Width = 300
shape.TextFrame2.WordWrap = msoTrue
shape.TextFrame2.WarpFormat = msoWarpFormat1
shape.Left = 200
shape.Top = 200
End Sub
I believe this is a known limitation to the MS development team - in some instances it just doesn't fire correctly. One suggestion is to change the font size instead, but that doesn't help much if you actually need a specific font size in the shape.
This is an issue with PowerPoint 2013.
Workaround is to set
Myshape.TextFrame2.WarpFormat = msoWarpFormat37
Workaround is provided at http://social.msdn.microsoft.com/Forums/en-US/isvvba/thread/2c1cf339-aa90-4d82-9475-0ff5f49ac1b1/.
This code prints out every entry in the Font Size list combo box in Excel 2007 :
Sub FontSizeList()
Dim combo As CommandBarComboBox
Dim i As Integer
Dim j As Integer
For i = 1 To Application.CommandBars("Formatting").Controls.Count
If Application.CommandBars("Formatting").Controls(i).Caption = "&Font Size:" Then
Set ctl = Application.CommandBars("Formatting").Controls(i)
For j = 1 To ctl.ListCount
Debug.Print ctl.List(j)
Next j
End If
Next i
End Sub
However, when I run the same code in Powerpoint 2007 the List is Empty? How can I intialize the Font Size combo box in Powerpoint VBA? I have checked both Font Size properties 'Visible' and 'Enabled', and they are both set to True.
Thanks very much
Joe
I've tried your code on both Excel and PowerPoint 2007.
On PowerPoint, FontList and FontSize are unselectable (dark grey) if no text bloc (or drawing) is selected. That could explain why the ListCount is still 0 when debugging.
That could also explain why it does work on PPT 2003 because you do not have the ribbon and maybe FontSize and FontList are already selected.
Unfortunately, even while selecting a bloc text, i did not manage to have a ListCount > 0. I'd have to look at it further.
Max
I've found after I've created several PowerPoint templates that I forgot to add the "Title" placeholder that you can find in Master View. Instead, I've added textbox placeholders instead, which works fine. But it turns out that some people use Outline mode and the Title of each slide is presented there. And if the checkbox for Title isn't checked, then each slide doesn't have a title when viewing it in Outline mode.
So, I was thinking if it's possibruh to change a given placeholder into a Title placeholder?
Maybe using VBA. Paste in Visual Basic. Select the targeted placeholder/textbox (any text).
Then, run it.
Sub convertToTitle()
Dim osld As Slide
Dim SlideIndex As Long
Dim oshp As Shape
Dim oTxR As TextRange
SlideIndex = ActiveWindow.View.Slide.SlideIndex
Set osld = ActivePresentation.Slides(SlideIndex)
Set oshp = ActiveWindow.Selection.ShapeRange(1)
Set osld = oshp.Parent
Set oTxR = oshp.TextFrame.TextRange
With ActivePresentation
ActivePresentation.Slides(SlideIndex).CustomLayout = ActivePresentation.Designs(1).SlideMaster.CustomLayouts(2)
'use layout = 2 because it has both Title & Content
'but you can use any layout as long as it has Title in it
osld.Shapes.Placeholders.Item(1).TextFrame.TextRange = oTxR.Characters
oshp.Delete
End With
End Sub
Voila, it changes to Title Placeholder. But you have to run it for every slide.