VBA created shapes sometimes break ranks

K

KitingJoe

Hi,
approx. every fifth time I run the code below one shape break ranks:
Jumping a bit to the left or right or is AutoSized, so that is smaller.

What's the matter???

Thanks.
Joe

Sub Example()

Dim dblLeft As Double
Dim dblTop As Double
Dim dblLeftCurrent As Double
Dim dblWidth As Double
Dim dblHeight As Double
Dim dblA As Double

dblLeft = 60
dblTop = 200
dblLeftCurrent = dblLeft
dblWidth = 10
dblHeight = 10

For dblA = 1 To 15

ActiveWindow.Selection.SlideRange.Shapes.AddTextbox(msoTextOrientationHorizontal, dblLeftCurrent, dblTop, _
dblWidth,
dblHeight).Select
With ActiveWindow.Selection.TextRange
.Text = "X"
With .Font
.Name = "Arial"
.Size = 6
.Bold = msoFalse
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
End With
End With
With ActiveWindow.Selection.ShapeRange
.Fill.Transparency = 0#
.Line.Weight = 0.25
.Line.Visible = msoTrue
.Line.BackColor.RGB = RGB(255, 255, 255)
.Line.Style = msoLineThinThin
.TextFrame.MarginLeft = 1
.TextFrame.MarginRight = 1
.TextFrame.MarginTop = 1
.TextFrame.MarginBottom = 1
DoEvents
With .TextFrame
.HorizontalAnchor = msoAnchorCenter
.VerticalAnchor = msoAnchorMiddle
.WordWrap = msoFalse
.AutoSize = ppAutoSizeNone
End With
End With
ActiveWindow.Selection.Unselect
dblLeftCurrent = dblLeftCurrent + dblWidth
Next
End Sub
 
K

KitingJoe

Hi Steve,

I found exactly the same "solution" and deleted it from the example, not to
confuse anybody. Anymore I thought: "give PPT time to do the necessary
things" and inserted a DoEvents. But this makes the problem worse.

Funny enough my "configuration" now is in a mode, that no defect is annoying
me. But nothing intentional changed!?!

Hope that will last but it's a nasty thing for developers.

Ahoi, Joe
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top