How to find the Byte size of each slide

[RandomGerman]

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:



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

[John Wilson]

There are several problems in doing this. Any images on the master will be included in the file size so I would apply a plain layout to a copy.

This should give an idea of where the big slides are though


Sub getSizes()
Dim oFS As Object
Dim opres As Presentation
Dim ocopy As Presentation
Dim L As Long
Dim sngSize As Single
Dim strFileName As String
Dim folderpath As String
Dim sizes() As String
Set opres = ActivePresentation
On Error Resume Next
folderpath = Environ("TEMP") & "\Slides\"
Kill folderpath & "*.*"
MkDir folderpath
opres.SaveCopyAs folderpath & "copy.pptx"
Call killoldshapes(opres)
For L = 1 To opres.Slides.Count
Set ocopy = Presentations.Open(folderpath & "copy.pptx", WithWindow:=False)
ocopy.Slides.Range(MyRange(L + 1, opres.Slides.Count)).Delete
If L > 1 Then ocopy.Slides.Range(MyRange(1, L - 1)).Delete
ocopy.SaveAs folderpath & "Slide" & L & ".pptx"
ocopy.Close
Next L
ReDim sizes(1 To opres.Slides.Count)
Set oFS = CreateObject("Scripting.FileSystemObject")
For L = 1 To opres.Slides.Count
strFileName = folderpath & "Slide" & CStr(L) & ".pptx"
sngSize = oFS.GetFile(strFileName).Size
sizes(L) = Format(Int(sngSize / 1024), "##,##") & "kb"
With opres.Slides(L).Shapes.AddShape(msoShapeRectangle, 10, 10, 200, 20)
.TextFrame2.TextRange.Text = "SIZE " & sizes(L)
.Tags.Add "SIZE", "YES"
End With
Next
End Sub


Function MyRange(ByVal StartIndex As Long, ByVal EndIndex As Long) As Variant
Dim Arr() As Long
Dim I As Long
ReDim Arr(StartIndex To EndIndex)
For I = StartIndex To EndIndex: Arr(I) = I: Next
MyRange = Arr
End Function


Sub killoldshapes(opres As Presentation)
Dim osld As Slide
Dim L As Long
For Each osld In opres.Slides
If osld.Shapes.Count > 0 Then
For L = osld.Shapes.Count To 1 Step -1
If osld.Shapes(L).Tags("SIZE") = "YES" Then osld.Shapes(L).Delete
Next L
End If
Next osld
End Sub

[SamT]

Can you copy one slide at a time to a different Presentation? That seems better than copying the entire Presentation and deleting all but one every time.

[Paul_Hossler]

A starting point might be to open the PPTX with a ZIP program, and extract the Slides folder

You could then read the file size for each 'slide' since each is a separate file

21042

21043

[John Wilson]

Sadly the Slide.xml does give any approximation as to the actual slide size. It's a simple text file and normally only a few bytes.

[Paul_Hossler]

Sadly the Slide.xml does give any approximation as to the actual slide size. It's a simple text file and normally only a few bytes.


Yea, you're right -- I should have looked at the XML first

[RandomGerman]

Thank you, John!

Parts of your brillant code are quite different from the the road, I thought I should take. Is it in general a bad idea using the BuiltInDocumentProperties I tried to read out? When I tried, they created errors, and you obviously avoided them ...
I think I never saw the command GetFile before, so this is (another time) a new world you're opening for me.

Thanks again, and thanks to Sam and Paul, too, for spending some thoughts on this.

[John Wilson]

You should be able to read the Built In Doc props BUT only if the file is open. I created a File System Object which can read them WITHOUT opening. Trickier but a lot faster and more convenient.

[RandomGerman]

Well, in my above code I tried so (open, read, close), but failed. Maybe because I closed it, before giving out the value anywhere? But of course, reading it without opening is much more elegant.

[John Wilson]

Reading from the Built In Props failed for me too. Not sure why.

If you only need to read the size from a closed file and not other items you can use FileLen(path) too.