How to find the Byte size of each slide
Hello there,
this time I'm completely lost. I would like to write a macro to show the slide size (in kb) of any slide of a selection of slides. This is useful, because sometimes one gets a very big presentation and wants to find out, which of the slides make it that big.
How I think it should work:
1. Save a copy of the presentation and delete all slides except the first selected from this copy of the presentation
2. Read the KB of this copy of the presentation (which in fact is only slide 1 of the selection)
3. Go back to the original presentation
4. Create a shape in the top left corner of the slide
5. Paste the KB value into that shape
6. Delete the copy of the presentation mentioned in step 1
7. Do step 1 to 6 with slide no. 2 of the selection
and so on
8. Give the user an option to delete all these shapes with two clicks again
I have used the wonderful Zaptags-code, John created somewhere else in this forum, and I found a solution for step 8, and what I have written for step 4 and 5 will hopefully work, too, but there are several problems at the moment:
1. Step 1 - at the moment my code tags ALL selected slides, so the copy of the presentation includes the whole selection, not only slide 1 of it. I have actually no idea how to make it work for one slide after the other
2. Reading the number of bytes fails - the error message says "method 'value' fails". When I replace it with debug.print and without the command value, I get "Unknown error". What is wrong with that part?
3. The blue shapes created in step 4 become part of the copy, too. This is strange (for my poor understanding), as the creation of the shape starts after closing the copy of the presentation.
4. Before returning to the beginning and go on with the next slide, the first copy of the presentation should be deleted. I haven't found a command for that by now. Isn't it possible to delete a closed presentation, when knowing the path and the name?
There might be more mistakes, but at this stage I would be happy to find solutions for the mentioned and then see what happens (or not happens) next. ;-)
I know, this is a big one, but any little step may help. Thank you!
My fragment of a code:
Code:
Option Explicit
Sub ByteCountAdd()
Dim otemp As Presentation
Dim opres As Presentation
Dim TempFile As String
Dim ByteValue As String
Dim osld As Slide
Dim oshp As Shape
Dim L As Long
Dim i As Integer
Set opres = ActivePresentation
Call zaptags(opres)
For i = 1 To ActiveWindow.Selection.SlideRange.Count
ActiveWindow.Selection.SlideRange(i).Tags.Add "THISONE", "YES"
TempFile = "C:\Users\Chef\Desktop\TempFile.pptx"
'The path above is only used for testing, I want to see, what happens
'Later I'd prefer to use: Environ("TEMP") & "\" & "TempFile" & ".pptx" to make the process 'invisble'
' make a copy
opres.SaveCopyAs TempFile
'open the copy
Set otemp = Presentations.Open(TempFile)
'delete unwanted slides
For L = otemp.Slides.Count To 1 Step -1
Debug.Print otemp.Slides(L).Tags("THISONE")
If otemp.Slides(L).Tags("THISONE") <> "YES" Then otemp.Slides(L).Delete
Next L
otemp.Save
'Read number of bytes
Debug.Print otemp.BuiltInDocumentProperties("Number of bytes") 'creates "unknown error"
ByteValue = otemp.BuiltInDocumentProperties("Number of bytes").Value 'creates "method 'value' failed" error
otemp.Close
'Create shape to show number of bytes
Set osld = ActivePresentation.Slides(i)
Set oshp = osld.Shapes.AddShape(Type:=msoShapeRectangle, Left:=0, Top:=0, Width:=200, Height:=25)
With oshp
With .Fill
.Visible = msoTrue
.Transparency = 0
.ForeColor.RGB = RGB(0, 0, 255)
End With
With .Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 255)
.Weight = 0.75
End With
With .Tags
.Add "BYTECOUNT", "YES"
End With
With .TextFrame2
With .TextRange
With .Font
.Name = "Arial"
.Size = 12
.Fill.ForeColor.RGB = RGB(255, 255, 255)
.Bold = msoTrue
.Italic = msoFalse
.UnderlineStyle = msoNoUnderline
End With
.Characters.Text = ByteValue
.Paragraphs.ParagraphFormat.Alignment = msoAlignCenter
End With
.VerticalAnchor = msoAnchorMiddle
.Orientation = msoTextOrientationHorizontal
.MarginBottom = 7.0866097
.MarginLeft = 7.0866097
.MarginRight = 7.0866097
.MarginTop = 7.0866097
.WordWrap = msoTrue
End With
End With
Next i
Exit Sub
End Sub
Sub ByteCountDel()
Dim sld As Slide
Dim L As Long
If MsgBox("Do you want to delete ALL byte size shapes from the entire presentation?", vbYesNo) <> vbYes Then Exit Sub
On Error Resume Next
For Each sld In ActivePresentation.Slides
For L = sld.Shapes.Count To 1 Step -1
If sld.Shapes(L).Tags("BYTECOUNT") = "YES" Then sld.Shapes(L).Delete
Next L
Next sld
End Sub
Sub zaptags(opres)
Dim osld As Slide
On Error Resume Next
For Each osld In opres.Slides
osld.Tags.Delete ("THISONE")
Next osld
End Sub
