PDA

View Full Version : Solved: Would an array make my code faster?



TrippyTom
10-16-2006, 05:02 PM
Hi guys (and gals):

I wrote a macro to add 11 lines to every slide in the presentation, but if the user is working in a large presentation, this isn't an immediate process. I was wondering if it would speed it up if I used an array instead of a series of for/next loops.

And if so, how would I go about doing that? (I am extremely afraid of arrays) :fright:

matthewspatrick
10-17-2006, 05:37 AM
What does your code look like now?

fumei
10-17-2006, 01:28 PM
Yes, it is hard to make suggestions without knowing what you are doing now.

Multi-dimensional arrays CAN be a bit daunting, but simply arrays are a snap, and very useful.

TrippyTom
10-18-2006, 08:43 AM
Ok, here's my code:

Sub AllGuidesAdd()
On Error GoTo myEnd
Dim shp As Shape
Dim sld As Slide
Dim myColor As Long
Dim i As Variant
Dim Nslides As Long
Dim mySlide As Long
Nslides = ActivePresentation.Slides.Range.Count
myColor = RGB(255, 0, 0) 'red <-- Change this value to whatever you want if you don't like red
mySlide = ActiveWindow.View.Slide.SlideIndex
ScreenUpdating = False
For Each sld In ActivePresentation.Slides
For i = 1 To Nslides

'this part checks to see if the lines exist first, and if they do, it exits the routine to avoid layering lines on top of each other.
For Each shp In ActivePresentation.Slides(i).Shapes.Range
Select Case shp.Name
Case Is = "y1"
Exit Sub
End Select
Next shp
'This part draws the lines
With ActivePresentation.Slides(i).Shapes.AddShape(Type:=msoShapeRectangle, Top:=48.24, Left:=0, Width:=720, Height:=0)
.Name = "y1"
.Line.ForeColor.RGB = myColor
End With
With ActivePresentation.Slides(i).Shapes.AddShape(Type:=msoShapeRectangle, Top:=66.24, Left:=0, Width:=720, Height:=0)
.Name = "y2"
.Line.ForeColor.RGB = myColor
End With
With ActivePresentation.Slides(i).Shapes.AddShape(Type:=msoShapeRectangle, Top:=102.24, Left:=0, Width:=720, Height:=0)
.Name = "y3"
.Line.ForeColor.RGB = myColor
End With
With ActivePresentation.Slides(i).Shapes.AddShape(Type:=msoShapeRectangle, Top:=120.24, Left:=0, Width:=720, Height:=0)
.Name = "y4"
.Line.ForeColor.RGB = myColor
End With
With ActivePresentation.Slides(i).Shapes.AddShape(Type:=msoShapeRectangle, Top:=300.24, Left:=0, Width:=720, Height:=0)
.Name = "y5"
.Line.ForeColor.RGB = myColor
End With
With ActivePresentation.Slides(i).Shapes.AddShape(Type:=msoShapeRectangle, Top:=473.76, Left:=0, Width:=720, Height:=0)
.Name = "y6"
.Line.ForeColor.RGB = myColor
End With
With ActivePresentation.Slides(i).Shapes.AddShape(Type:=msoShapeRectangle, Top:=0, Left:=23.76, Width:=0, Height:=540)
.Name = "x1"
.Line.ForeColor.RGB = myColor
End With
With ActivePresentation.Slides(i).Shapes.AddShape(Type:=msoShapeRectangle, Top:=0, Left:=342, Width:=0, Height:=540)
.Name = "x2"
.Line.ForeColor.RGB = myColor
End With
With ActivePresentation.Slides(i).Shapes.AddShape(Type:=msoShapeRectangle, Top:=0, Left:=360, Width:=0, Height:=540)
.Name = "x3"
.Line.ForeColor.RGB = myColor
End With
With ActivePresentation.Slides(i).Shapes.AddShape(Type:=msoShapeRectangle, Top:=0, Left:=378, Width:=0, Height:=540)
.Name = "x4"
.Line.ForeColor.RGB = myColor
End With
With ActivePresentation.Slides(i).Shapes.AddShape(Type:=msoShapeRectangle, Top:=0, Left:=696.24, Width:=0, Height:=540)
.Name = "x5"
.Line.ForeColor.RGB = myColor
End With
ScreenUpdating = True
Next
Next
myEnd:
End Sub


MOS MASTER directed me to a routine that emulates the ScreenUpdating feature in Excel, but for PowerPoint: http://skp.mvps.org/ppt00033.htm

This helps a little, but I was wondering if my code above would be able to be optimized so it wasn't so dependant on the # of slides in any presentation.

The reason I'm naming the shapes is because I need to refer to them later if the user wants to remove them.

mdmackillop
10-19-2006, 02:35 PM
Hi Trippy, while not cutting out the looping, why not put your drawing routine in another sub. It clears up presentation and you could use an array to store your values for easier maintenance
eg

'This part draws the lines
DoLine i, "y", 48.28, 0, 720, 0
DoLine i, "x", 0, 23.76, 0, 540

Sub DoLine(i As Long, Nm As String, Tp As Single, Lft As Single, Wdth As Single, Ht As Single)
With ActivePresentation.Slides(i).Shapes.AddShape(Type:=msoShapeRectangle, Top:=Tp, Left:=Lft, Width:=Wdth, Height:=Ht)
.Name = Nm & CStr(i)
.Line.ForeColor.RGB = myColor
End With
End Sub

TrippyTom
10-20-2006, 09:11 AM
Thanks Mack ;)

I will try that, but you know I'm deathly afraid of arrays. It's like calculus - I just don't have the mentality for it. :dunno
[EDIT:]--> How do I name each line with this method? I need to do this so I can delete them with a different macro later.
[Edit2:]--> NEVERMIND, i figured it out ;) Now, somehow my first line is not changing to red, but I'll figure it out, thanks for all your help :)

Any other ideas to make it faster? :)

mdmackillop
10-20-2006, 01:55 PM
I had a quick look, but couldn't see a way to select multiple slides and apply the same data to all in one step, (as you can do in Excel), which would be the real timesaver. Maybe try a search for this particular facility?

Paul_Hossler
04-11-2007, 03:53 PM
FWIW - I looks to me like you're doing N^2 loops since you have a nested For loop, each going through all the slides. I tried a couple of changes, and the results look the same, but I didn't have enought slides to do any timing

HTH,

Paul

'Now:
For Each sld In ActivePresentation.Slides
For i = 1 To Nslides


' revised fragment to remove the nested loop, and to use a "With" to save having to resolve all the objects address each time

For Each sld In ActivePresentation.Slides
With sld.Shapes

For Each shp In .Range
If shp.Name = "y1" Then Exit Sub
Next shp

With .AddShape(Type:=msoShapeRectangle, Top:=48.24, Left:=0, _
Width:=720, Height:=0)
.Name = "y1"
.Line.ForeColor.RGB = myColor
End With


etc,

TrippyTom
04-11-2007, 04:55 PM
Thank you Paul,
I will look into that.

It's funny - I wrote that code a while ago, but looking back on it now it kinda looks rediculous to me. I think I would have written it better if I rewrote it today. Or maybe not... :rotlaugh:

Paul_Hossler
04-11-2007, 07:09 PM
Let me know how it works out

mdmackillop
04-12-2007, 02:00 PM
It's funny - I wrote that code a while ago, but looking back on it now it kinda looks rediculous to me. I think I would have written it better if I rewrote it today

How often have I said that! It just shows we're learning.:thumb