Quantcast
Channel: General Office Development forum
Viewing all articles
Browse latest Browse all 2257

Do I need to update ...?

$
0
0


... 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


     

                                                                                                                                        



Viewing all articles
Browse latest Browse all 2257

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>