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





Reply With Quote