... the shapes that I need the adjustment-values from? If so how would I do that?
Hi,
I have discovered something really weird. I am programming something in VB.Net for PowerPoint. Some of the autoshapes in PP have adjustments. Now have a look at autoshape no 47 (it is the same with all similar arrow shapes; see code to insert autoshape47 below).
As of my knowledge the value of the adjustments is always a multiple of the shorter shape side of the autoshape. In this case if you maximize the width of the arrow-tip the second code snippset shows factor 5 for the arrow-tip width - because the arrow-width is 5 times as long as the shape height (shape height = shorter side of the shape = reference side as up to here).
In the next step leave everything as it is but make the shape height twice or three times as large as the current shape width. Now by doing this the reference for the adjustments has changed. Not the height but the width is now the shorter side of the shape. Therefore if things would be logic the adjustment for the width of the arrow-tip should become 0.5 because the arrow-tip is half as wide as the shapes width.
And here is my problem: The factor shown for the arrow-tip width has NOT changed from 5 to 0.5 ! (Just run the code again!) It stayes to be 5 – which is wrong, I think?!?!
As soon as you touch the adjustment for the arrow-tip width it will change to the right (new) value.
My question: Is there any good idea how to ALWAYS receive the correct values? So I would be able to work with the correct value further on in my program. I do not want to “hope” that the user “takes care” of this issue.
Many thanks.
And here is the code:
Insert AutoShape 47 on a new slide:
Private Sub InsertAutoShape47() Dim oActiveWindow As Object = Me.HostApplication.ActiveWindow() Dim oPresentation As Presentation = oActiveWindow.Presentation Dim oSlides As PowerPoint.Slides = oPresentation.Slides Dim oCustomLayout As CustomLayout = oSlides(1).CustomLayout Dim oSlidesNew As PowerPoint.Slides = oPresentation.Slides Dim oSlide As PowerPoint.Slide = oSlidesNew.AddSlide(oSlides.Count + 1, oCustomLayout) Dim oSlideShapes As PowerPoint.Shapes = oSlide.Shapes Dim oShapenew As PowerPoint.Shape = oSlideShapes.AddShape(47, 250, 250, 200, 20) GC.Collect() GC.WaitForPendingFinalizers() GC.Collect() GC.WaitForPendingFinalizers() End Sub
Get the adjustment values:
Private Sub GetArrowTip() Dim oActiveWindow As Object = Me.HostApplication.ActiveWindow() Dim oSelection As Selection = oActiveWindow.Selection Dim oPresentation As Presentation = oActiveWindow.Presentation Dim oShapeRange As PowerPoint.ShapeRange = oSelection.ShapeRange Dim A, B, C, SWidth, SHeight As Double Dim oSlides As PowerPoint.Slides = oPresentation.Slides Dim oCustomLayout As CustomLayout = oSlides(1).CustomLayout Dim oSlidesNew As PowerPoint.Slides = oPresentation.Slides Dim oSlide As PowerPoint.Slide = oSlidesNew.AddSlide(oSlides.Count + 1, oCustomLayout) Dim oSlideShapes As PowerPoint.Shapes = oSlide.Shapes Dim oShapenew As PowerPoint.Shape = oSlideShapes.AddShape(47, 250, 250, 200, 20) If oShapeRange.Count = 1 Then Dim oShape As PowerPoint.Shape = oShapeRange(1) Dim oArrowAdjustment As PowerPoint.Adjustments = oShape.Adjustments Dim oShapeType As Integer = oShape.AutoShapeType Select Case oShapeType Case 47 A = oArrowAdjustment.Item(1) B = oArrowAdjustment.Item(2) C = oArrowAdjustment.Item(3) SWidth = oShape.Width SHeight = oShape.Height Case Else MsgBox("Please select autoshape no 47.") Exit Sub End Select Else MsgBox("Please select one shape.") Exit Sub End If MsgBox("Arrow width: " & B & vbCrLf & "Arrow length = " & C & vbCrLf & "Shape height: " & SHeight & vbCrLf & "Shape width: " & SWidth) GC.Collect() GC.WaitForPendingFinalizers() GC.Collect() GC.WaitForPendingFinalizers() End Sub