├── .gitignore ├── CHANGES.txt ├── PPspliT-howto.docx ├── PPspliT-howto.pdf ├── PPspliT-macOS-howto.docx ├── PPspliT-macOS-howto.pdf ├── README.md └── src ├── MacOS ├── PPspliT for MacOS │ └── Install PPspliT.app │ │ └── Contents │ │ ├── Info.plist │ │ ├── MacOS │ │ └── applet │ │ ├── PkgInfo │ │ ├── Resources │ │ ├── PPspliT.ppam │ │ ├── Scripts │ │ │ └── main.scpt │ │ ├── applet.icns │ │ ├── applet.rsrc │ │ └── description.rtfd │ │ │ └── TXT.rtf │ │ └── _CodeSignature │ │ └── CodeResources └── build_macos_dmg.sh ├── PPT11- ├── PPspliT.bas ├── PPspliT.ppa └── PPspliT.ppt ├── PPT12+ ├── AboutForm.frm ├── AboutForm.frx ├── PPspliT.bas ├── PPspliT.ppam ├── PPspliT.pptm ├── ProgressForm.frm └── ProgressForm.frx ├── common_resources ├── about-button.gif ├── about.png ├── mouse-button.gif ├── ppsplit-button.gif ├── ppsplit-large.bmp ├── ppsplit-large.png ├── ppsplit-small.png ├── ppsplit-uninst-large.bmp ├── ppsplit-wide.bmp ├── ppsplit.ico ├── ppsplit.xcf └── slide-numbers.gif ├── license.txt └── ppsplit_installer.nsi /.gitignore: -------------------------------------------------------------------------------- 1 | PPspliT-setup.exe 2 | .DS_store 3 | PPspliT.dmg 4 | old_releases 5 | ~$PPspliT* 6 | -------------------------------------------------------------------------------- /CHANGES.txt: -------------------------------------------------------------------------------- 1 | 2.6 (Mar 2024) 2 | - Colored emojis in text paragraphs were not correctly hidden when supposed to. 3 | This is now fixed, thus closing issue #20. 4 | - Fixed a bug that could cause PPspliT to crash in the presence of an effect with 5 | the "hide after playing" property set. 6 | - Added support for custom slideshows: slide sequences in custom slideshows are 7 | now updated to include slides that are added as a result of splitting. 8 | Although the main goal of PPspliT differs from that of custom slideshows (these 9 | are usually meant for presenting live with an audience, whereas split slides 10 | are meant for redistribution), in some cases custom slideshows may also be 11 | used as a convenient way to define slide subsets that can be readily printed 12 | (or exported to PDF using a virtual printer): this is the use case that this 13 | feature aims at addressing. 14 | Thanks to Olivier Descout for suggesting this improvement. 15 | 16 | 2.5 (May 2023) 17 | - Fixed a bug that caused PPspliT to crash if executed on a completetly 18 | empty presentation (i.e., with no slides). 19 | - Introducing support for cross-slide hyperlinks pointing to the previous 20 | or next slide: such hyperlinks have both the slide ID and the slide 21 | index set to -1, which was unhandled before. Thanks to Rolf Rabenseifner 22 | for highlighting this issue. 23 | - Fixed a bug in handling invalid cross-slide hyperlinks pointing to a 24 | non-existent slide index. This might happen in case a previously existent 25 | target slide is deleted after creating the hyperlink, and the overall 26 | slide deck becomes shorter than the index the hyperlink points to. 27 | Thanks again to Rolf Rabenseifner for submitting examples that revealed 28 | this issue. 29 | - Fixed a bug in handling animation effects with the "hide after animation" 30 | property set (the initial visibility state of the shape could have been 31 | wrong). 32 | - Improved handling of a few emphasis effects that can have a temporary 33 | effect on the shapes they are applied to. 34 | 35 | 2.4 (April 2023) 36 | - Fixed cross-slide hyperlinks after splitting. Previously, they were broken 37 | because of slide index changes occurring during the split. Thanks to 38 | Rolf Rabenseifner for pointing out this issue. 39 | - Text highlighting now (mostly) supported: its visibility is now 40 | synchronized with that of the text it is applied to. Some glitches may 41 | still occur because PowerPoint VBA does not have any native methods to 42 | clear/hide the highlighting. This fixes #17. 43 | 44 | 2.3 (January 2023) 45 | - In some rare cases slide decks may contain animation effects applied to 46 | empty paragraphs, which PowerPoint generally forbids at the user interface 47 | level. In even rarer cases, such animated empty paragraphs may occur at the 48 | end of a text frame, which causes PPspliT to fail because empty paragraphs 49 | at the end of a text frame are not even included in the total paragraphs 50 | count. Thanks to Jake Lee for pointing out this issue (in 51 | https://github.com/maxonthegit/PPspliT/issues/16), for which a workaround 52 | is now implemented. 53 | 54 | 2.2 (December 2022) 55 | - Fixed a bug that caused PPspliT to fail at the initialization stage in 56 | the presence of emphasis animation effects affecting shape colors with 57 | a target color taken from the slide color scheme. This happened regardless 58 | of whether the triggering animation effects occurred in the slides selected 59 | for being split or not. Thanks to David Doty for highlighting this issue. 60 | - Slightly improved error reporting for failures occurring during the 61 | initialization stage. 62 | - Updated regression tests to include emphasis effects with a target color 63 | from the slide color scheme as well as text paragraphs with a variety of 64 | bullet types and a structure deeper than 5 levels. 65 | 66 | 2.1 (December 2022) 67 | - Minor bug fixes. 68 | - Restored full functionality for PowerPoint 2007. 69 | 70 | 2.0 (December 2022) 71 | - Deeply redesigned core engine to eliminate the need to use the system 72 | clipboard altogether. This definitively addresses issues like #3 and #7, which 73 | highlighted race conditions triggered by external applications handling the 74 | system clipboard, and also rules out issues like #12, which highlighted a 75 | similar problem randomly occurring even in the absence of any applications 76 | interfering with the clipboard. It is therefore now safe to use the system 77 | clipboard while a slide deck is being split. 78 | - Splitting a selection of non-contiguous slides is now supported. 79 | - Handling of entry/exit effects applied to text paragraphs has been improved. 80 | In particular: 81 | - Ordered lists whose items (or paragraphs) were set to appear in any order 82 | different from their natural order resulted in item numbering being mixed 83 | up. This is now fixed. Thanks to David Wong for reporting this issue. 84 | - Bullets should now be always preserved and font resizing implied by the text 85 | auto-fit property should be correctly honored. 86 | - Text paragraphs containing a mixture of standard text and equations in the 87 | native PowerPoint 2013 format are now supported. 88 | - Leaner progress dialog box, now consisting of a single progress bar. 89 | - Worked around a known limitation affecting the ability to properly assign 90 | fill/line colors for emhpasis effects. 91 | - Improved handling of animation effects that are set for auto-reverse or 92 | being rewound after playing. 93 | - A full regression test suite is now embedded in the PPspliT macro file. 94 | - Improved code comments. 95 | +------------------------------------------------------------------------------+ 96 | | As a collateral effect of this significant set of changes, starting from | 97 | | this release no further development will happen for PowerPoint versions | 98 | | prior to 2007 (Windows only). As of PPspliT release 2.0, even users of | 99 | | PowerPoint 2007 may experience some issues. | 100 | | Although this has never been announced in advance, the following statements | 101 | | apply: | 102 | | - I consider unlikely that such versions still have a significant number of | 103 | | users nowadays, making the impact of this change likely negligible. | 104 | | - Implementing all the applied changes would be overly demanding compared to | 105 | | the benefit of such an activity. | 106 | | - Support for older PowerPoint versions is not dropped anyway: it is just | 107 | | frozen in its current state: no new features will be added or bug fixes | 108 | | will be applied for that code base. | 109 | +------------------------------------------------------------------------------+ 110 | 111 | ================================ 112 | 113 | 1.27 (April 2022) 114 | - Preserving some shape properties across slides requires using a more 115 | persistent shape property than the shape ID (which is regenerated for each 116 | copy of the same shape). AlternativeText was used as a property "carrier" so 117 | far, but this causes loss of some potentially useful information (for example 118 | for producing accessible PDFs). Now the code has switched to using Tags, which 119 | are more flexible and not expected to cause any information loss. 120 | This addresses https://github.com/maxonthegit/PPspliT/issues/11. 121 | - Slightly enlarged the about box to leave more room for text when using 122 | high-DPI displays. 123 | 124 | 1.26 (December 2021) 125 | - Apparently, per-paragraph animation effects applied to a text box can become 126 | "corrupted" when all the text in the box is deleted: instead of removing the 127 | animation steps altogether, PowerPoint leaves behind a single animation step 128 | for which the "text animation" property cannot be set (i.e., it is impossible 129 | to determine whether the animation is applied to a text paragraph or the 130 | whole containing shape) and is not even played during the slideshow. This 131 | abnormal condition caused PPspliT to mistakenly detect the animation as 132 | applied to a paragraph and, consequently, fail due to the paragraph being 133 | non-existent. An additional check has been introduced to cope with this 134 | condition. Thanks to Torsten-Karl Strempel for pointing out this issue. 135 | - Improved About dialog box: text box turned to a label, added hyperlinks. 136 | 137 | 1.25 (November 2021) 138 | - Addressed a glitch that caused text paragraphs in split slides to be aligned 139 | differently from the original slide. Thanks to Torsten-Karl Strempel for 140 | pointing out this issue. 141 | 142 | 1.24 (November 2020) 143 | - This relese fixes bug https://github.com/maxonthegit/PPspliT/issues/6: slides 144 | were improperly assigned a slide transition effect after being split. 145 | 146 | 1.23 (November 2020) 147 | - This release fixes the bug reported in 148 | https://github.com/maxonthegit/PPspliT/issues/5: the Brightness property of 149 | ColorFormat objects was sometimes accessed even in PowerPoint releases which 150 | do not implement it (most notably, PowerPoint 2007). This resulted in a quite 151 | frequent error while splitting certain animation effects in the affected 152 | PowerPoint releases (indeed, this should have impacted only PowerPoint 2007) 153 | and happened because version checking code did not work as expected. 154 | - Fixed a bug in the split modes that preserve slide numbers, which caused 155 | a "Permission denied" error when more than one placeholder among page number, 156 | date/time and footer was enabled on the slide deck. This affected only 157 | PowerPoint releases 2003 and earlier. 158 | 159 | 1.22 (August 2020) 160 | - Improved slide number adjustment function: besides preserving the original 161 | slide numbering during the split, now it is also possible to add a subindex to 162 | each slide that derives from splitting a single original slide. For example, 163 | a slide numbered 5 would be split into "5.1", "5.2", "5.3", etc. 164 | Thanks to Soumitra Pal for suggesting this new feature. 165 | - Revised add-in toolbar to accommodate the aforementioned function. 166 | - Updated documentation accordingly. 167 | 168 | 1.21 (June 2020) 169 | - No functional changes. 170 | - Comments at the beginning of the source code have been moved to README.md. 171 | - First (experimental) MacOS release. 172 | - Suppressed warning for Office 2013/2016 in Windows installer. 173 | 174 | 1.20 (June 2019) 175 | - The code for PowerPoint 2007+ is unchanged (the version number has just 176 | been updated). 177 | - Improved preservation of text properties in PowerPoint 2003- for animation 178 | effects applied to text paragraphs. Thanks to Mattia Rocco for pointing out 179 | this problem. 180 | 181 | 1.19 (March 2018) 182 | - The enhancement introduced between release 1.17 and 1.18 used an attribute 183 | that is apparently unsupported by PowerPoint 2007. This release does not 184 | introduce any new features, but simply contains an additional check that 185 | prevents usage of this attribute in PowerPoint releases prior to 2010. 186 | Thanks to David Johns for pointing out this problem. 187 | 188 | 1.18 (January 2018) 189 | - Font colors were sometimes set incorrectly when rendering text effects. 190 | In particular, text was sometimes improperly changed to white color after 191 | a text entry effect was processed by the add-in, thus making it invisible 192 | on a white background. This happened when the original font color was set 193 | to one of the scheme colors. In fact, in this case instead of restoring the 194 | original RGB values of the font color, the add-in just restored the scheme 195 | color index (correct) while disregarding the associated brightness level 196 | (incorrect). As a consequence, text that was set to a gray shade from the 197 | slide color scheme was turned to white (because, indeed, the brightness 198 | level of the gray shade was lost). Thanks to Mark Foti for pointing out this 199 | issue. 200 | 201 | 1.17 (June 2017) 202 | - When the "Split on click-triggered animations" box was unchecked, animation 203 | effects occurring in the timeline before the first mouse-triggered effect 204 | were incorrectly processed (thanks to William Bonaldo Falls for providing me 205 | with a minimal example showing the problem). 206 | 207 | 1.16 (February 2017) 208 | - Two main improvements: 209 | 1) A dialog box is now displayed when a range of slides is currently 210 | selected, to confirm the user's intention to only split slides in 211 | that range. 212 | 2) Improved rendering of text paragraph entry effects. 213 | After some testing, certain statements aimed at preserving line spacing 214 | in the processed text frames proved to be more detrimental than useful, 215 | therefore they have been commented out. 216 | This change applies only to PowerPoint 2007 and later. 217 | Thanks to Stefan Fedl for providing me with a useful test case to 218 | investigate this issue. 219 | 220 | 1.15 (June 2016) 221 | - No "real" changes. Just relaxed some warnings in the installer about 222 | PowerPoint 2016 being unsupported (which was incorrect). 223 | 224 | 1.14 (August 2015) 225 | - Improved handling of animations of text paragraphs. 226 | In particular, copying paragraphs between shapes sometimes required 227 | inserting an additional newline character at the paragraph end, which was 228 | never later removed. Although generally harmless, this caused text 229 | alignment to be garbled in some cases, especially when text was 230 | vertically aligned at bottom. Now injected newline characters are 231 | automatically removed after processing the relevant paragraphs (thanks to 232 | John Rowe for isolating the issue in a minimal example). 233 | 234 | 1.13 (February 2015) 235 | - Improved processing of bullet formatting in itemized lists. Still far 236 | from being perfect, but a richer number of cases should now be correctly 237 | handled (thanks to Scott Otterson for sending a minimal example 238 | triggering a specific instance of the problem). 239 | 240 | 1.12 (October 2014) 241 | - Fixed a bug in the clearParagraph subroutine: the bullet character was 242 | improperly set to character 160, but it had to be set to character 32 243 | (space) instead (thanks to Leon Carvalho for pointing this out). 244 | 245 | 1.11 (Jul 2013) 246 | - Fixed a bug that could cause crashes of the add-in in at least 50% of the 247 | installations when processing path motion effects. Evidence of the bug 248 | depended on the nationality where the add-in was installed (yes, it's not 249 | a joke!) 250 | The bug lied in the conversion of decimal separator characters from the 251 | '.' character used in the internal representation of path motion effects 252 | to the character adopted in the host machine's locale setting. 253 | 254 | 1.10 (May 2013) 255 | - Fixed a small bug that could cause a crash when fixing slide numbers in 256 | the presence of multiple slide masters (the first slide master was not 257 | always displayed as the current master, causing shape selection to fail 258 | in some cases). This bug only affected the implementation for PowerPoint 259 | <=2003. 260 | - Fixed a glitch with the detection of the selected slide range. It only 261 | affected splitting on a selected range of slides, and caused errors in 262 | recognizing the range if slides were not selected in the order in which 263 | they appeared in the presentation. Now the range is assumed to start at 264 | the lowest numbered selected slide and to end at the highest numbered 265 | selected slide: regardless of the range being contiguous or not, all the 266 | slides in between are processed. 267 | - Reversed semantic for internal variables representing the status of the 268 | "Split on mouse click" and "Adjust slide numbers" buttons. This has no 269 | impact on the final user except that, in case of failure of the add-in, 270 | the internal status is reverted to "True" for both of them (until now 271 | it was reverted to "False"), regardless of the status of the buttons. 272 | 273 | 1.9 (May 2013) 274 | - Fixed a (very subtle) problem that caused skipping of some animation 275 | effects in the timeline during the preprocessing phase that deletes 276 | shapes that are supposed to appear later in a slide. The problem occurred 277 | when, during that phase, deletion of a shape caused disappearance 278 | from the timeline of effects for the same shape that preceded the 279 | currently processed effect. 280 | - Fixed release number in the about dialog for PowerPoint 2003. 281 | - Fixed progress percentage indication during the initial phase that fixes 282 | slide numbers (it contained decimals). 283 | 284 | 1.8 (Mar 2013) 285 | - Fixed some problems with animated text ranges containing text with 286 | superscript or subscript style. 287 | - Very minor fixes in the PowerPoint 2003 toolbar (there was a missing 288 | button group separator). 289 | - Removed a misplaced comment about the unsupported features in the 290 | source code for PowerPoint 2007. 291 | - The progress bar documenting the advancement of the slide number adjustment 292 | missed the percentage value in PowerPoint 2007. 293 | 294 | 295 | 1.7 (Jan 2013) 296 | - If slide numbers are displayed in slide footers, it is now possible to 297 | keep them consistent with those appearing in the original presentation: 298 | if splitting a single slide from the original presentation results in 299 | several slides, the same slide number is displayed for all of them. 300 | - When applying an animation effect to a placeholder for the first time, 301 | the "animate background shape" option is disabled but implicitly 302 | activated. Relevant effects now take this into account and implicitly 303 | assume that the whole shape is to be animated when it is a placeholder. 304 | - The ChangeLineColor emphasis effect did not apply correctly if the 305 | shape had no line shown. Same for the ChangeFillColor effect. Fixed. 306 | - Improved Office XP/2003 toolbar. 307 | - Added an about dialog box. 308 | 309 | 1.6 (Sep 2012) 310 | - Removed the progress bar from the progress form. This solves problems 311 | with missing Microsoft Form controls and relaxes architecture 312 | dependency. 313 | 314 | 1.5 (Jan 2012) 315 | - Fixed a small regression. 316 | There is a special case when for a text box there are separate animations 317 | for the shape and the contained text. In this case, just after having 318 | pasted the box to implement an entry effect, the text contents must be 319 | immediately deleted by the applyEffect function itself if they are 320 | supposed to appear later on, because they have been pasted together with 321 | the shape. 322 | Now, this behaviour must be restricted to entry effects for text 323 | paragraphs only. Applying the same behaviour (i.e., purging future 324 | effects immediately after pasting a shape) to every shape leads to 325 | incorrect results. 326 | 327 | 328 | 1.4 (Jan 2012) 329 | - Solved a small bug in shape scaling effects. 330 | Resizing failed for all shapes having a locked aspect ratio and text 331 | frames where text auto-fitting was enabled. 332 | 333 | 1.3 (Nov 2011) 334 | - Improved handling of effects affecting text paragraphs instead of entire 335 | shapes. This should solve issues such as lost text styles (bold, italic, 336 | underline, etc.) and early appearing paragraphs in the split slides. 337 | - Fixed a small bug which caused incorrect handling of rotation emphasis 338 | effects. The bug affected shapes that were already rotated before 339 | applying 340 | the effect. 341 | - Improved handling of shape resize emphasis effects in Office <=2003: now 342 | the font size is more likely to be correctly updated even when the effect 343 | operates on a group of shapes. Note that: 1) font size for text boxes 344 | in nested groups will still not be updated, and 2) sometimes the font 345 | size 346 | may be scaled incorrectly (guess why? Because PowerPoint returns a 347 | garbled 348 | size for existing text). 349 | - Improved handling of entry effects for shapes that have an entry effect 350 | on their own + an entry effect for each text paragraph they have inside. 351 | - (Again) improved icon for Office XP (2002) and 2003. Now it should match 352 | the button icon size, so that ugly scalings do not happen any longer. 353 | - The installer should now correctly issue a warning also when at least one 354 | of the detected Office releases is not recognized (e.g., Office 2000). 355 | 356 | 1.2 (Oct 2011) 357 | - Improved (un)installer: now (un)configures the add-in for every 358 | installed PowerPoint releases, not just the first one. 359 | Moreover, detection of installed PowerPoint releases has been improved. 360 | 361 | 1.1 (Dec 2010) 362 | - Worked around a PowerPoint bug affecting handling of effects with 363 | the "hide on next mouse click" option activated. 364 | - Fixed a bug in the update of the progress bar which caused a crash 365 | when handling effects with the "hide on next mouse click" option 366 | activated. 367 | - Support for Office 2010, both 32 and 64 bit versions. Installer 368 | automatically recognizes the correct architecture. 369 | - Slightly improved button icon for Office XP (2002) and 2003. 370 | 371 | 1.0 (Nov 2009) 372 | - First release 373 | -------------------------------------------------------------------------------- /PPspliT-howto.docx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/PPspliT-howto.docx -------------------------------------------------------------------------------- /PPspliT-howto.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/PPspliT-howto.pdf -------------------------------------------------------------------------------- /PPspliT-macOS-howto.docx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/PPspliT-macOS-howto.docx -------------------------------------------------------------------------------- /PPspliT-macOS-howto.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/PPspliT-macOS-howto.pdf -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ``` 2 | _____ _____ _ _ _______ 3 | | __ \| __ \ | (_)__ __| 4 | | |__) | |__) |__ _ __ | |_ | | 5 | | ___/| ___/ __| '_ \| | | | | 6 | | | | | \__ \ |_) | | | | | 7 | |_| |_| |___/ .__/|_|_| |_| 8 | | | 9 | |_| by Massimo Rimondini 10 | ``` 11 | PPspliT is a PowerPoint add-in that transforms each slide of a presentation into 12 | a sequence of slides, each displaying the contents of the original slide as they 13 | would appear at every intermediate animation step. As such, its most natural 14 | context of application is to produce a redistributable version of a presentation 15 | in a _flat_ file format like PDF. 16 | 17 | To some extent, PowerPoint already provides export functions that are meant to 18 | include animations in the target file (e.g., it can export a presentation as a 19 | video). However, to my knowledge, a true conversion of existing slides into an 20 | equivalent sequence of static (i.e., animation-less) slides that is suitable for 21 | printing or PDF export has never been natively offered by PowerPoint. PPspliT 22 | tries to fill this gap. 23 | 24 | ---- 25 | * [Features](#features) 26 | * [Usage](#usage) 27 | * [Building](#building) 28 | * [Prerequisites](#prerequisites) 29 | * [Packaging for Windows](#packaging-for-windows) 30 | * [Packaging for MacOS](#packaging-for-macos) 31 | * [Known limitations](#known-limitations) 32 | * [Manual installation](#manual-installation) 33 | * [References](#references) 34 | * [Acknowledgments](#acknowledgments) 35 | * [Troubleshooting](#troubleshooting) 36 | ---- 37 | 38 | ## Features 39 | * **User experience** 40 | * Fully integrated with PowerPoint: it is natively implemented in Visual Basic 41 | for Applications (VBA). 42 | * Adds a new tab in PowerPoint's native ribbon toolbar (or dedicated toolbar 43 | for PowerPoint releases prior to 2007): splitting slides is a one-click task. 44 | * Can operate on a range of selected slides or on the whole presentation, if no 45 | slides are selected. 46 | * **Capabilities** 47 | * Supports all entry, emphasis, exit and motion path effects applied to slide 48 | shapes (with some caveats, see below). 49 | * Supports "Rewind when done playing", "Hide on next mouse click" and 50 | "Auto-reverse" effect flags, as well as reversed motion paths. 51 | * Can split slides at every click-triggered animation effect (like it would 52 | happen during a slideshow) or at each and every animation effect (useful to 53 | preserve multiple intermediate animations that are played without any speaker 54 | interaction). 55 | * Updates [custom 56 | slideshows](https://support.microsoft.com/en-gb/office/create-and-present-a-custom-show-09d4d340-3c47-4125-b177-0de3be462c5d) 57 | by replacing each slide with those that result from splitting it. Custom 58 | slideshows are actually named sequences of slides from the full deck and, 59 | besides being used at presentation time, they can also be selected as 60 | predefined slide ranges when printing. Therefore, this feature can be 61 | exploited to conveniently export (by printing to PDF) slide subsequences that 62 | are predefined in the form of custom slideshows. 63 | * Can optionally preserve slide numbers during splitting: if slide footers 64 | contain text frames with dynamically computed slide numbers, these can be 65 | overwritten so that numbers in all the slides resulting from splitting a single 66 | original slide match its original slide number. 67 | * Operates with native PowerPoint shapes: the slides produced after the split 68 | are derived from the original presentation and still contain editable shapes. 69 | * Format-agnostic: since the final product is still a slide deck, you can 70 | export it to any document format for which you have a virtual printer or file 71 | converter installed. PDF is implicitly supported, as PowerPoint has been 72 | including an export function to this format for a few years now. 73 | 74 | Some examples displaying the operation of the add-in can be found in the 75 | [project home page][Home page]. 76 | 77 | 78 | ## Usage 79 | Simply click on the "Split animations" button of the PPspliT toolbar. 80 | Using the appropriate checkboxes on the same toolbar, you can choose to split 81 | slides on animation effects that are triggered by a mouse click (most common 82 | usage) or just every animation effect (this may be especially slow). You can 83 | also choose to preserve slide numbers during the split. 84 | 85 | [Usage instructions](PPspliT-howto.pdf) are also available. 86 | 87 | *Notice*: in all releases older than 2.0 the add-in makes heavy use of the 88 | system clipboard. Therefore, it is very important that you refrain from using it 89 | during the split and that no programs interfere with the clipboard at all. 90 | Effective since release 2.0, this requirement has been relaxed, and the system 91 | clipboard can be safely used while a slide deck is being split. 92 | 93 | **Warning**: running the add-in will modify your presentation. Even though it is 94 | generally possible to revert the changes using the undo feature (Ctrl+Z), it is 95 | strongly advised to work on a copy of the original slide deck to avoid losing 96 | your work by accidentally overwriting it with the split presentation. 97 | 98 | It may take a while for the split process to complete. If you are wondering 99 | 1. why so much code and 100 | 2. why does it take so long to split animations 101 | 102 | here are some hints: 103 | * PowerPoint applies slideshow effects to rasterized versions of the shapes. 104 | Instead, in PPspliT the same effects are re-implemented on the original shape 105 | objects. 106 | * VBA has some sparse bugs here and there, which allow limited or no access to 107 | shape properties. I needed to work these around to my best. 108 | * Each animation step requires creating a new slide, which is time consuming. 109 | * For each animation step, all the shapes that are supposed to appear later on 110 | by means of a subsequent entry effect or to have disappeared because of a 111 | preceding exit effect must be appropriately removed. 112 | 113 | 114 | ---- 115 | 116 | ## Building 117 | As PPspliT is implemented as a VBA macro inside PowerPoint, there is no true 118 | _build_ procedure. The source code is embedded in PowerPoint binary files that 119 | are saved as native PowerPoint add-ins: this is also the reason why changes are 120 | tracked in separate files (e.g., [PPspliT.bas](src/PPT12+/PPspliT.bas)). \ 121 | The only step that requires _building_ is the generation of distributable 122 | installers. 123 | 124 | ### Prerequisites 125 | * Windows 126 | * [Nullsoft Scriptable Install System (NSIS)](https://sourceforge.net/projects/nsis/) 127 | * [Office 2007 Custom UI editor](http://openxmldeveloper.org/blog/b/openxmldeveloper/archive/2009/08/07/7293.aspx) -- As of June 2020, the link seems broken: you may try using the [Office RibbonX Editor](https://github.com/fernandreu/office-ribbonx-editor) instead. 128 | * MacOS 129 | * Script Editor (ships natively with MacOS) 130 | 131 | ### Packaging for Windows 132 | * Edit the VBA macro inside `PPT12+\PPspliT.pptm` as needed, then prepare the 133 | file as follows: 134 | * Update the release number if required (also in the about dialog box). 135 | * Save the file (`PPspliT.pptm`). 136 | * Export each module from the Visual Basic for Applications editor into 137 | corresponding `.bas`, `.frm` and `.frx` files. 138 | * Export the whole file as a PowerPoint add-in (`PPspliT.ppam`). 139 | * Open `PPspliT.pptm` using the Office 2007 Custom UI Editor or the Office 140 | RibbonX Editor, update the release number if required, and save the file. 141 | * Do the same for `PPspliT.ppam`. 142 | * Apply consistent changes to file `PPT11-\PPspliT.ppt`, save it, export each 143 | module and export the whole PPT file as a PowerPoint 97-2003 add-in (`PPspliT.ppa`). 144 | * Edit file `ppsplit_installer.nsi` to refresh the release number if required. 145 | * Process file `ppsplit_installer.nsi` through NSIS (usually it is enough to 146 | right-click on the file and select "Compile NSIS script"). File `PPspliT-setup.exe` 147 | should then be generated in the parent folder. 148 | 149 | ### Packaging for MacOS 150 | * Apply changes to `PPspliT.pptm` and export it as PowerPoint add-in `PPspliT.ppam` 151 | as described above for the Windows case. 152 | * Open file `MacOS/PPspliT for MacOS/Install PPspliT.app` using Apple's Script 153 | Editor. 154 | * Refresh resource `PPspliT.ppam` inside the script by dragging and dropping the 155 | updated `PPspliT.ppam` inside the Script Editor. 156 | * Save the installer and close the Script Editor. 157 | * Open a Terminal window and run script `MacOS/PPspliT for MacOS/build_macos_dmg.sh` 158 | to generate file `PPspliT.dmg`. 159 | 160 | ---- 161 | 162 | ## Known limitations 163 | Yes, the list is apparently long, but please look carefully through it because 164 | it consists mostly of corner cases. 165 | * PPspliT does not offer any PDF conversion functions: it is not meant to. It 166 | just processes a presentation to split animations, then it is up to your 167 | favorite PDF generation software or PowerPoint's native PDF export function to 168 | generate the final PDF (or whatever other document format). 169 | * PPspliT does not preserve animation effects: the slide deck resulting from a 170 | split accurately renders the status of the slideshow at each intermediate 171 | animation step, but every slide is cleared of all animation effects. This means 172 | that you cannot have "moving shapes" in your final _flat_ (PDF) document. Even 173 | if animations were preserved in the slides, embedding them in the final document 174 | would require advanced processing functions for every possible output document 175 | format, which is out of the scope of PPspliT, and would lead to much less 176 | portable documents. 177 | * All of the add-in features are implemented for all PowerPoint versions, but 178 | minor glitches may exist with versions prior to 2007, sometimes due to VBA 179 | limits or bugs. 180 | * Some functions are knowingly unsupported and may never be implemented: 181 | 1. *Slide transitions* 182 | — Since they are meant to smoothen slide changes, they have no 183 | persistent effects on their contents, hence no action that needs to be 184 | rendered by PPspliT. 185 | 186 | 2. *Shape dimming after playing an effect* 187 | 188 | 3. *Most effects/actions triggered by mouse clicks on a specific shape* 189 | — As an exception, cross-slide hyperlinks *are* supported: their targets 190 | are updated to point to the originally meant slides even after they have 191 | been renumbered by the split. Slide previews using the 192 | [zoom feature](https://support.microsoft.com/en-us/office/use-zoom-for-powerpoint-to-bring-your-presentation-to-life-9d6c58cd-2125-4d29-86b1-0097c7dc47d7) 193 | are *not* supported anyway, meaning that they may become broken after splitting. 194 | 195 | 4. *The shaking and blinking emphasis effects* 196 | — This is due to a PowerPoint bug. 197 | 198 | 5. *Effects applied to individual shapes of composite objects (SmartArt, charts)* 199 | — To my knowledge, the interface exposed by VBA to alter the properties of 200 | such shapes is somewhat limited. For example, a position property like 201 | `Selection.ShapeRange(1).SmartArt.Nodes(1).Shapes(1).Left` is read-only, and 202 | methods like `ScaleHeight` or `Cut` affect the whole SmartArt object despite 203 | being applied to its individual shapes. Shape groups *are* of course supported. 204 | 205 | 6. *For emphasis effects, repetition and "Until next click" duration* 206 | — The *duration* parameter of emphasis effects normally indicates the 207 | time that it takes to play the effect until its end. For very few effect 208 | types, this same setting indicates the time for which the effect persists 209 | on its target shape instead. Effects that are not persistent (i.e., they 210 | have an established duration in seconds) are simply ignored by PPspliT. Any 211 | other emphasis effects are assumed to last until the end of the slide (or 212 | until a subsequent effect is applied to the same slide). This means that 213 | emphasis effects that last "until next click" are *not* supported and are 214 | handled in the same way as effects that last "until end of slide". 215 | On the other hand, the *repeat* setting allows to loop the effect's action 216 | for an established number of iterations or, alternatively, until the next mouse 217 | click or the end of the current slide. Since effect loops don't have any 218 | meaningful outcome on a statically rendered slide, PPspliT simply ignores 219 | this setting and assumes that all emphasis effects are applied once (i.e., 220 | without loops). 221 | 222 | 7. *Accurate rendering of color effects* 223 | — PowerPoint implements color change effects in a way that is honestly 224 | hard for me to reverse engineer. PPspliT approximates these effects but the 225 | final applied color may not perfectly coincide with the one natively applied 226 | by PowerPoint. 227 | 228 | 8. *Many emphasis and motion effects that apply to a single text paragraph 229 | instead of a whole shape* 230 | — In general, all those effects whose rendering requires separation of 231 | the text frame from its parent shape are unlikely to be supported. 232 | 233 | 9. *Rasterized shape scaling and non-proportional text resizing* 234 | — PowerPoint applies any effects to rasterized versions of the shapes. As 235 | a consequence, grow/shrink effects affect all the elements of a shape 236 | (including, e.g., shape border thickness) and not necessarily preserve the 237 | aspect ratio. PPspliT resizes the native shape instead, thus preserving its 238 | components (including border thickness) and resulting in a sharper rendering, 239 | because the native vector shapes are preserved and there is no interpolation 240 | introduced by resizing or rotation effects. While this is generally welcome, 241 | the final result may sometimes differ from the intended one. Most evidently, 242 | PPspliT only supports proportional growing/shrinking of text elements: 243 | if a grow/shrink effect occurs on a text element and is set to only affect it 244 | vertically or horizontally, PPspliT renders it by adjusting the font size by 245 | an amount that is a good compromise between horizontal and vertical growth/shrink, 246 | but no "compression" or "expansion" of the text occurs. 247 | 248 | 10. *Accurate rendering of some rotation effects* 249 | — When a slide show is played, PowerPoint rotates shapes around the 250 | center of the visible shape body. Instead, PPspliT rotates them around the 251 | center of the container box. Sometimes the container box may be larger than the 252 | visible shape, resulting in a different center of rotation being applied. To 253 | explain the difference, consider an arc, whose container box is the rectangle 254 | (or, possibly, square) that encloses the full circle: at slideshow time 255 | PowerPoint can rotate the arc around the center of the arc stroke itself, 256 | whereas PPspliT would rotate it around the center of the container box: since 257 | the latter is generally (much) larger than the visible arc, the final 258 | impression is that the visible shape (the arc) has "wandered around". 259 | 260 | 11. *Exit/entry effects applied to shapes that are part of a slide layout are only 261 | partially supported* 262 | — In fact, these shapes are turned into placeholders (instead of 263 | disappearing altogether) when one attempts to delete them. While this is not an 264 | issue in the vast majority of cases, if such placeholders have a formatting 265 | applied (e.g., a background color) they may stay visible even when they are not 266 | expected to. 267 | 268 | 12. *Adjustment of slide numbers on a PPTX file that is imported into PowerPoint 269 | <=2003 using the Microsoft Office Compatibility Pack* 270 | — This is a very old special condition and is never expected to occur. 271 | 272 | 13. *Adjustment of (dynamic) slide numbers that appear in standard text boxes* 273 | — Although dynamically updated slide numbers can be inserted in any text 274 | paragraph, PPspliT is only able to adjust them (i.e., preserve a numbering that 275 | is coherent with the one of the original slides even after splitting) if such 276 | numbers appear in special placeholder boxes defined in slide masters and 277 | inserted as headers/footers in the slide deck. 278 | 279 | 14. *Animations in slide masters* 280 | 281 | 15. *Animation effects whose order is strictly dependent on timing* 282 | — Animation effects can be played after a mouse click ("on click"), after 283 | the preceding effect has ended ("after previous") or at the same time as a 284 | preceding effect ("with previous"). While ordering of the effect outcomes is 285 | strictly defined in the first two cases, it may depend on timing in the third 286 | case. For example, if effect B follows effect A in the animation sequence, both 287 | effects are set to play "with previous" but effect A has a *delay* set to 1 288 | second whereas effect B has no delay, effect B is played before effect A. 289 | PPspliT does not consider this kind of reordering, and assumes that effects are 290 | always played in the same order in which they appear in the animation sequence. 291 | 292 | 16. *Something else I am not aware of* 293 | 294 | --- 295 | 296 | ## Manual Installation 297 | PPspliT comes packaged with an installer which eases setup by means of a 298 | convenient wizard. The installer is tuned to operate in many different typical 299 | configurations (as a sole exception, security features in recent releases of 300 | macOS may require following specific [(un)installation 301 | instructions](https://www.maxonthenet.altervista.org/downloads/PPspliT/PPspliT-macOS-howto.pdf)). 302 | However, in the unlikely case in which it fails, you can still attempt a 303 | manual installation by following the procedure below. 304 | 305 | 306 | 1. Download the latest [PPspliT macro file](https://github.com/maxonthegit/PPspliT/raw/master/src/PPT12%2B/PPspliT.ppam) 307 | and save it to a location of your choice. 308 | As an alternative, download the latest [Windows installer file][Home page] 309 | (even if you are using macOS), open it with your favorite Zip unpacker (do _not_ start the installer), 310 | find file `PPspliT.ppam` inside the archive and save it to a location of your choice. 311 | 312 | 313 | 314 | 2. Start PowerPoint. 315 | 3. Add the downloaded `PPspliT.ppam` as a PowerPoint add in as described at https://support.microsoft.com/en-us/office/add-or-load-a-powerpoint-add-in-3de8bbc2-2481-457a-8841-7334cd5b455f, 316 | namely: 317 | 318 | * In case you are using PowerPoint for Windows: 319 | 320 | 4. Click the _File_ tab, then _Options_. 321 | 5. In the _Options_ dialog box, click _Add-Ins_. 322 | 6. In the _Manage_ list at the bottom of the dialog box, click _PowerPoint Add-ins_, 323 | then click _Go_. 324 | 7. In the _Add-Ins_ dialog box, click _Add New_. 325 | 8. In the _Add New PowerPoint Add-In_ dialog box, browse for the previously saved 326 | `PPspliT.ppam` file and then click _OK_. 327 | 9. A security notice might appear. In this case, click on _Enable Macros_ and 328 | then click _Close_. 329 | 330 | * If, instead, you are using PowerPoint for macOS: 331 | 332 | 4. Open the _Tools_ menu on the top bar (i.e. not the PowerPoint ribbon toolbar, 333 | but rather the macOS menu bar at the top of the screen) and select _PowerPoint add ins_. 334 | 5. Click on _+_ and select file `PPspliT.ppam` that you saved above. 335 | 336 | Note that,even when this issue occurs, the installer should have already 337 | taken care of copying the required files to a proper location in your system 338 | (usually `%APPDATA%\Microsoft\AddIns\PPspliT` for Windows systems, and 339 | `$HOME/Library/Group\ Containers/UBF8T346G9.Office` for macOS systems). 340 | Therefore, the steps for unpacking and saving file `PPspliT.ppam` described above 341 | can be skipped. 342 | 343 | 344 | --- 345 | 346 | ## References 347 | * [Project home page][Home page] 348 | * At the time of first sketching the add-in code, I used [this blog post by Neil 349 | Mitchell](http://neilmitchell.blogspot.com/2007/11/creating-pdf-from-powerpoint-with.html) 350 | and [its follow-up](https://neilmitchell.blogspot.com/2007/11/powerpoint-pdf-part-2.html) as greatly inspirational starting points. 351 | 352 | ## Acknowledgments 353 | Although I am the only developer of the add-in, several suggestions for 354 | improvements and bug fixes came in the form of feedback from its end users. Some 355 | of them are acknowledged in the [changelog](CHANGES.txt). 356 | 357 | ---- 358 | 359 | # Troubleshooting 360 | 361 | _The add-in is splitting only the first slide instead of the whole slide deck._ 362 | 363 | Maybe you have accidentally selected the first slide in the left-side thumbnail 364 | pane of PowerPoint. Just try clicking anywhere in the main pane of 365 | PowerPoint (i.e., the slide editor) and try PPspliTting again. 366 | 367 | --- 368 | 369 | _The (Windows) installer fails to recognize any PowerPoint releases (error 370 | message "the add in has been left unconfigured")._ 371 | 372 | This may happen, for example, when a pre installed OEM PowerPoint release is 373 | being used. There is not much that can be done to address this issue, as 374 | specially packed PowerPoint releases may be harder to detect for the installer 375 | and the effort to improve its recognition capabilities exceeds the user 376 | reported impact of this problem. However, you can still work around this little 377 | problem by performing a [manual installation](#manual-installation). 378 | 379 | --- 380 | 381 | _Error "Macro cannot be found or has been disabled because of security" is 382 | displayed every time a split is attempted._ 383 | 384 | As an outdated but, possibly, still valid explanation, a [security update 385 | released by Microsoft](http://support.microsoft.com/kb/2598041/en-us") around 386 | April 2012 may cause this issue with most VBA-based applications that make use 387 | of dialog boxes, including PPspliT. To correct this problem, Microsoft suggests 388 | deleting cached versions of control type libraries, which is harmless for your 389 | system. I can confirm that this solution has worked for me. Basically, you have 390 | to delete all `.exd` files stored in `%HOMEPATH%\Application 391 | Data\Microsoft\Forms` and `%TEMP%\VBE`. Please rely on the official instructions 392 | from Microsoft, which can be found in the page mentioned above. \ 393 | If this does not solve your problem, then either you are still using a really 394 | outdated PPspliT release (1.5 was known to have such compatibility problems) or 395 | your macro security settings may need to be reviewed. 396 | 397 | 398 | 399 | 400 | [Home page]: http://www.maxonthenet.altervista.org/ppsplit.php 401 | -------------------------------------------------------------------------------- /src/MacOS/PPspliT for MacOS/Install PPspliT.app/Contents/Info.plist: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | CFBundleAllowMixedLocalizations 6 | 7 | CFBundleDevelopmentRegion 8 | en 9 | CFBundleExecutable 10 | applet 11 | CFBundleIconFile 12 | applet 13 | CFBundleIdentifier 14 | com.apple.ScriptEditor.id.Install-PPspliT 15 | CFBundleInfoDictionaryVersion 16 | 6.0 17 | CFBundleName 18 | Install PPspliT 19 | CFBundlePackageType 20 | APPL 21 | CFBundleShortVersionString 22 | 2.6 23 | CFBundleSignature 24 | aplt 25 | CFBundleVersion 26 | 1 27 | LSMinimumSystemVersionByArchitecture 28 | 29 | x86_64 30 | 10.6 31 | 32 | LSRequiresCarbon 33 | 34 | NSAppleEventsUsageDescription 35 | This script needs to control other applications to run. 36 | NSAppleMusicUsageDescription 37 | This script needs access to your music to run. 38 | NSCalendarsUsageDescription 39 | This script needs access to your calendars to run. 40 | NSCameraUsageDescription 41 | This script needs access to your camera to run. 42 | NSContactsUsageDescription 43 | This script needs access to your contacts to run. 44 | NSHomeKitUsageDescription 45 | This script needs access to your HomeKit Home to run. 46 | NSHumanReadableCopyright 47 | ©2024 Massimo Rimondini 48 | NSMicrophoneUsageDescription 49 | This script needs access to your microphone to run. 50 | NSPhotoLibraryUsageDescription 51 | This script needs access to your photos to run. 52 | NSRemindersUsageDescription 53 | This script needs access to your reminders to run. 54 | NSSiriUsageDescription 55 | This script needs access to Siri to run. 56 | NSSystemAdministrationUsageDescription 57 | This script needs access to administer this system to run. 58 | OSAAppletShowStartupScreen 59 | 60 | OSAScriptingDefinition 61 | PPspliT installer 62 | WindowState 63 | 64 | bundleDividerCollapsed 65 | 66 | bundlePositionOfDivider 67 | 700 68 | dividerCollapsed 69 | 70 | eventLogLevel 71 | 0 72 | name 73 | ScriptWindowState 74 | positionOfDivider 75 | 350 76 | savedFrame 77 | 79 143 999 672 0 0 1440 875 78 | selectedTab 79 | result 80 | 81 | 82 | 83 | -------------------------------------------------------------------------------- /src/MacOS/PPspliT for MacOS/Install PPspliT.app/Contents/MacOS/applet: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/src/MacOS/PPspliT for MacOS/Install PPspliT.app/Contents/MacOS/applet -------------------------------------------------------------------------------- /src/MacOS/PPspliT for MacOS/Install PPspliT.app/Contents/PkgInfo: -------------------------------------------------------------------------------- 1 | APPLaplt -------------------------------------------------------------------------------- /src/MacOS/PPspliT for MacOS/Install PPspliT.app/Contents/Resources/PPspliT.ppam: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/src/MacOS/PPspliT for MacOS/Install PPspliT.app/Contents/Resources/PPspliT.ppam -------------------------------------------------------------------------------- /src/MacOS/PPspliT for MacOS/Install PPspliT.app/Contents/Resources/Scripts/main.scpt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/src/MacOS/PPspliT for MacOS/Install PPspliT.app/Contents/Resources/Scripts/main.scpt -------------------------------------------------------------------------------- /src/MacOS/PPspliT for MacOS/Install PPspliT.app/Contents/Resources/applet.icns: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/src/MacOS/PPspliT for MacOS/Install PPspliT.app/Contents/Resources/applet.icns -------------------------------------------------------------------------------- /src/MacOS/PPspliT for MacOS/Install PPspliT.app/Contents/Resources/applet.rsrc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/src/MacOS/PPspliT for MacOS/Install PPspliT.app/Contents/Resources/applet.rsrc -------------------------------------------------------------------------------- /src/MacOS/PPspliT for MacOS/Install PPspliT.app/Contents/Resources/description.rtfd/TXT.rtf: -------------------------------------------------------------------------------- 1 | {\rtf1\ansi\ansicpg1252\cocoartf2761 2 | \cocoatextscaling0\cocoaplatform0{\fonttbl} 3 | {\colortbl;\red255\green255\blue255;} 4 | {\*\expandedcolortbl;;} 5 | } -------------------------------------------------------------------------------- /src/MacOS/PPspliT for MacOS/Install PPspliT.app/Contents/_CodeSignature/CodeResources: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | files 6 | 7 | Resources/PPspliT.ppam 8 | 9 | 0M7rkKW7RFHLDFlfXdH5gAoQaws= 10 | 11 | Resources/Scripts/main.scpt 12 | 13 | 2LagiDy8uXmMYZGSz86FePF3N74= 14 | 15 | Resources/applet.icns 16 | 17 | sINd6lbiqHD5dL8c6u79cFvVXhw= 18 | 19 | Resources/applet.rsrc 20 | 21 | GILHkbEAu5CcnVEbNI514d6rI8g= 22 | 23 | Resources/description.rtfd/TXT.rtf 24 | 25 | zVa782ehNqArcc0CLAK2tfVc5tA= 26 | 27 | 28 | files2 29 | 30 | Resources/PPspliT.ppam 31 | 32 | hash 33 | 34 | 0M7rkKW7RFHLDFlfXdH5gAoQaws= 35 | 36 | hash2 37 | 38 | tbmWtwclzx9Jwx1a4K89KTHbfbXnWQOZK3TQeFfdI/k= 39 | 40 | 41 | Resources/Scripts/main.scpt 42 | 43 | hash 44 | 45 | 2LagiDy8uXmMYZGSz86FePF3N74= 46 | 47 | hash2 48 | 49 | /M1EG6shSB8ZRY4qJ9Qv/Zj4ZEvClk5gKTZQTxrzlh4= 50 | 51 | 52 | Resources/applet.icns 53 | 54 | hash 55 | 56 | sINd6lbiqHD5dL8c6u79cFvVXhw= 57 | 58 | hash2 59 | 60 | J7weZ6vlnv9r32tS5HFcyuPXl2StdDnfepLxAixlryk= 61 | 62 | 63 | Resources/applet.rsrc 64 | 65 | hash 66 | 67 | GILHkbEAu5CcnVEbNI514d6rI8g= 68 | 69 | hash2 70 | 71 | 8bLw4MPmA++cxXZibKrq4UPcmafiHo4AQY0VzN+h5UE= 72 | 73 | 74 | Resources/description.rtfd/TXT.rtf 75 | 76 | hash 77 | 78 | zVa782ehNqArcc0CLAK2tfVc5tA= 79 | 80 | hash2 81 | 82 | E2Of5u5DgQzKUK7JRt9vkPRgZy0Rfo/8wBH7NBpsx/0= 83 | 84 | 85 | 86 | rules 87 | 88 | ^Resources/ 89 | 90 | ^Resources/.*\.lproj/ 91 | 92 | optional 93 | 94 | weight 95 | 1000 96 | 97 | ^Resources/.*\.lproj/locversion.plist$ 98 | 99 | omit 100 | 101 | weight 102 | 1100 103 | 104 | ^Resources/Base\.lproj/ 105 | 106 | weight 107 | 1010 108 | 109 | ^version.plist$ 110 | 111 | 112 | rules2 113 | 114 | .*\.dSYM($|/) 115 | 116 | weight 117 | 11 118 | 119 | ^(.*/)?\.DS_Store$ 120 | 121 | omit 122 | 123 | weight 124 | 2000 125 | 126 | ^(Frameworks|SharedFrameworks|PlugIns|Plug-ins|XPCServices|Helpers|MacOS|Library/(Automator|Spotlight|LoginItems))/ 127 | 128 | nested 129 | 130 | weight 131 | 10 132 | 133 | ^.* 134 | 135 | ^Info\.plist$ 136 | 137 | omit 138 | 139 | weight 140 | 20 141 | 142 | ^PkgInfo$ 143 | 144 | omit 145 | 146 | weight 147 | 20 148 | 149 | ^Resources/ 150 | 151 | weight 152 | 20 153 | 154 | ^Resources/.*\.lproj/ 155 | 156 | optional 157 | 158 | weight 159 | 1000 160 | 161 | ^Resources/.*\.lproj/locversion.plist$ 162 | 163 | omit 164 | 165 | weight 166 | 1100 167 | 168 | ^Resources/Base\.lproj/ 169 | 170 | weight 171 | 1010 172 | 173 | ^[^/]+$ 174 | 175 | nested 176 | 177 | weight 178 | 10 179 | 180 | ^embedded\.provisionprofile$ 181 | 182 | weight 183 | 20 184 | 185 | ^version\.plist$ 186 | 187 | weight 188 | 20 189 | 190 | 191 | 192 | 193 | -------------------------------------------------------------------------------- /src/MacOS/build_macos_dmg.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # HOWTO 4 | # - Refresh the PPspliT.ppam resource in the installer bundle application (possibly using Apple's Script Editor) 5 | # - Run this script to generate the DMG file 6 | 7 | hdiutil create -size 1m -fs HFS+ -srcfolder PPspliT\ for\ MacOS/ -volname PPspliT -ov -format UDZO PPspliT.dmg 8 | 9 | -------------------------------------------------------------------------------- /src/PPT11-/PPspliT.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "PPspliT" 2 | ' 3 | ' 4 | ' _____ _____ _ _ _______ 5 | ' | __ \| __ \ | (_)__ __| 6 | ' | |__) | |__) |__ _ __ | |_ | | 7 | ' | ___/| ___/ __| '_ \| | | | | 8 | ' | | | | \__ \ |_) | | | | | 9 | ' |_| |_| |___/ .__/|_|_| |_| 10 | ' | | 11 | ' |_| by Massimo Rimondini - version 1.27 12 | ' 13 | ' first written by Massimo Rimondini in November 2009 14 | ' last update: April 2022 15 | ' Source code for PowerPoint 2003- 16 | ' 17 | ' 18 | 19 | 20 | 21 | 22 | 23 | ' This global variable indicates whether and how slide numbers should be kept 24 | ' consistent with the original set of slides. For example, if slide 6 is split 25 | ' into 3 slides, then all those 3 slides will be numbered 6 after splitting. 26 | ' As an alternative option, a subindex can be added to slide numbers, so that, 27 | ' for example, slide 6 is split into 6.1, 6.2, 6.3, etc. 28 | Public slideNumbersAdjustMode As Integer 29 | Public Const SLIDENUMBER_DONOTHING = 1 30 | Public Const SLIDENUMBER_BAKE = 2 31 | Public Const SLIDENUMBER_SUBINDEX = 3 32 | 33 | ' This global variable indicates whether animations should be split 34 | ' at each mouse-triggered event. If set to false, a separate slide is 35 | ' created for each and every animation. 36 | Public doNotSplitMouseTriggered As Boolean 37 | 38 | ' The following variables are for internal use only. 39 | Public cancelStatus As Boolean 40 | Public slide_number As Integer 41 | 42 | ' 43 | ' Convert decimal separators in the argument string from '.' to the most 44 | ' appropriate character for the system-configured locale. 45 | ' 46 | Private Function localizeDecimalSeparators(ByVal s As String) 47 | Dim d As Double, useCommaAsSeparator As Boolean 48 | useCommaAsSeparator = False 49 | 50 | ' Use a test value to check for the currently used decimal 51 | ' separator. In principle, we could use the user-supplied 52 | ' argument, but if it is a value between 0 and 1, it could 53 | ' miss the leading zero (e.g., -.1234), thus raising errors 54 | ' if we are not using the correct decimal separator in the 55 | ' assignment (which is exactly what we are trying to 56 | ' discover here). 57 | 58 | d = "1,2" 59 | ' If "," is not the decimal separator in use for the current 60 | ' system locale, this assignment results in losing the decimal 61 | ' separator. 62 | ' Now, this test requires care: in fact, localization of 63 | ' Double values seems to happen whenever a value is output on 64 | ' screen or is converted from a string, but in some way it does 65 | ' not seem to affect the internal representation of the Double 66 | ' value. Therefore, to check whether the decimal separator 67 | ' has survived the assignment, we need to look for its 68 | ' internal representation (which is "."), not its localized one. 69 | useCommaAsSeparator = (InStr(Trim(Str$(d)), ".") > 0) 70 | 71 | If useCommaAsSeparator Then 72 | d = Replace(s, ".", ",") 73 | Else 74 | d = s 75 | End If 76 | localizeDecimalSeparators = d 77 | End Function 78 | 79 | ' 80 | ' Hide a paragraph in a text box. 81 | ' Arguments are the shape containing the text frame and the index of 82 | ' the paragraph to be hidden. The subroutine takes care of preserving 83 | ' the space occupied by the paragraph, so that a text frame with 84 | ' auto-fit enabled will still be rendered accurately. 85 | ' 86 | Private Sub clearParagraph(sh As Shape, par) 87 | If sh.TextFrame.TextRange.Paragraphs(par).Lines.Count > 1 Then 88 | ' This is a word wrapped or multi-line paragraph: turn every 89 | ' word wrap into a real new line. This is required because the 90 | ' paragraph contents will be soon replaced with spaces, which 91 | ' have a different width than original characters, can therefore 92 | ' mess up word wrapping, hence the number of lines of this paragraph, 93 | ' hence the rendering of any following paragraphs. 94 | For i = 2 To sh.TextFrame.TextRange.Paragraphs(par).Lines.Count 95 | If Asc(sh.TextFrame.TextRange.Paragraphs(par).Lines(i - 1).Characters(sh.TextFrame.TextRange.Paragraphs(par).Lines(i - 1).Characters.Count)) <> 11 _ 96 | And Asc(sh.TextFrame.TextRange.Paragraphs(par).Lines(i - 1).Characters(sh.TextFrame.TextRange.Paragraphs(par).Lines(i - 1).Characters.Count)) <> 13 Then 97 | sh.TextFrame.TextRange.Paragraphs(par).Lines(i).Characters(1).InsertBefore Chr$(11) 98 | End If 99 | Next i 100 | End If 101 | Set p = sh.TextFrame.TextRange.Paragraphs(par) 102 | i = 1 103 | While i <= p.Characters.Count 104 | ' Replace paragraph contents with spaces. This is the best and 105 | ' most compatible way I found to "hide" a paragraph while keeping 106 | ' its original space occupied. 107 | If Asc(p.Characters(i)) <> 13 And Asc(p.Characters(i)) <> 11 Then 108 | p.Characters(i) = " " 109 | End If 110 | i = i + 1 111 | Wend 112 | ' Set bullet symbol too to " " (32 is the Unicode value) 113 | p.ParagraphFormat.Bullet.Character = 32 114 | End Sub 115 | 116 | ' 117 | ' Copies the contents of p2 into p1. 118 | ' This is used to restore a previously hidden paragraph. 119 | ' 120 | Private Sub copyParagraph(p1 As TextRange, p2 As TextRange) 121 | Dim newLineInserted As Boolean 122 | 123 | ' Sometimes text paragraphs are just empty. In this case 124 | ' return immediately 125 | If p2.Characters.Count = 0 Then Exit Sub 126 | 127 | If Asc(p2.Characters(p2.Characters.Count)) <> 13 Then 128 | ' This paragraph does not end with a new line (most 129 | ' likely because it is the last paragraph in the text 130 | ' frame). Here I add it because I can get all the 131 | ' formatting attributes of a paragraph only if it 132 | ' ends with a new line (this is PowerPoint magic...). 133 | ' In addition, although supported, using 134 | ' p2.Characters.InsertAfter here with PowerPoint <= 2003 135 | ' has the adverse effect that the paragraph text 136 | ' (property p2.Text) as well as its length are not 137 | ' updated, causing subsequent text editing steps 138 | ' (including, e.g., removal of the inserted newline) 139 | ' to fail. 140 | p2.InsertAfter Chr$(13) 141 | newLineInserted = True 142 | End If 143 | 144 | ' Apply contents and formatting from the original paragraph 145 | p2.Copy 146 | 147 | ' It seems that the following 3 assignments, applied *before* pasting 148 | ' the paragraph, reduce the number of cases in which bullet symbols 149 | ' are lost. The reason why this happens is completely obscure to me, but 150 | ' repeating the assignment *after* pasting (where this should happen) 151 | ' seems to be harmless. 152 | p1.ParagraphFormat.SpaceAfter = p2.ParagraphFormat.SpaceAfter 153 | p1.ParagraphFormat.SpaceBefore = p2.ParagraphFormat.SpaceBefore 154 | p1.ParagraphFormat.SpaceWithin = p2.ParagraphFormat.SpaceWithin 155 | 156 | p1.Paste 157 | 158 | p1.IndentLevel = p2.IndentLevel 159 | p1.ParagraphFormat.SpaceAfter = p2.ParagraphFormat.SpaceAfter 160 | p1.ParagraphFormat.SpaceBefore = p2.ParagraphFormat.SpaceBefore 161 | ' Try hard to set inter-line spacing. Applying a small variation should 162 | ' force PowerPoint to honor the value. 163 | p1.ParagraphFormat.SpaceWithin = p2.ParagraphFormat.SpaceWithin - 0.01 164 | p1.ParagraphFormat.SpaceWithin = p2.ParagraphFormat.SpaceWithin + 0.01 165 | 166 | ' Restore bullet formatting. Since there seems to be no 167 | ' way to get the currently used image for a bullet, care 168 | ' must be taken in updating the bullet attributes only if 169 | ' required, otherwise the applied image may be messed up 170 | ' and I may be unable to restore it. 171 | If p1.ParagraphFormat.Bullet.Type <> p2.ParagraphFormat.Bullet.Type Then 172 | p1.ParagraphFormat.Bullet.Type = p2.ParagraphFormat.Bullet.Type 173 | End If 174 | If p2.ParagraphFormat.Bullet.Type = ppBulletUnnumbered And p1.ParagraphFormat.Bullet.Character <> p2.ParagraphFormat.Bullet.Character Then 175 | p1.ParagraphFormat.Bullet.Character = p2.ParagraphFormat.Bullet.Character 176 | ' Apparently, not all the font attributes of a bullet can be reset (assigning 177 | ' some of them triggers an error). So, here we reimplement the relevant part 178 | ' of copyFontAttributes 179 | With p1.ParagraphFormat.Bullet.Font 180 | .Name = p2.ParagraphFormat.Bullet.Font.Name 181 | .Size = p2.ParagraphFormat.Bullet.Font.Size 182 | assignColor .Color, p2.ParagraphFormat.Bullet.Font.Color 183 | End With 184 | End If 185 | 186 | If p2.ParagraphFormat.Bullet.Type = ppBulletNumbered And p1.ParagraphFormat.Bullet.StartValue <> p2.ParagraphFormat.Bullet.StartValue Then 187 | p1.ParagraphFormat.Bullet.StartValue = p2.ParagraphFormat.Bullet.StartValue 188 | End If 189 | If p2.ParagraphFormat.Bullet.Type = ppBulletNumbered And p1.ParagraphFormat.Bullet.Style <> p2.ParagraphFormat.Bullet.Style Then 190 | p1.ParagraphFormat.Bullet.Style = p2.ParagraphFormat.Bullet.Style 191 | End If 192 | ' It's not over yet. 193 | ' Paste often acts in an "intelligent" way, by cutting away 194 | ' apparently useless spaces and other stuff. Here I need a 195 | ' really accurate paste, which preserves all the characters, 196 | ' therefore I overwrite (or enrich) the set of previously 197 | ' pasted characters. Overwriting the characters one by one 198 | ' ensures that the rest of formatting is left untouched, but 199 | ' here I may still be adding new text (e.g., new spaces), to 200 | ' which formatting must be applied. This is the reason of the 201 | ' call to copyFontAttributes. 202 | For i = 1 To p2.Characters.Count 203 | ' It's better to explicitly handle the case for added characters 204 | ' here. Failure to do so has caused inconsistent text rendering 205 | ' in some cases. 206 | If i <= p1.Characters.Count Then 207 | p1.Characters(i) = p2.Characters(i) 208 | Else 209 | p1.InsertAfter p2.Characters(i) 210 | End If 211 | copyFontAttributes p1.Characters(i).Font, p2.Characters(i).Font 212 | Next i 213 | 214 | ' Remove any previously inserted new line characters 215 | If newLineInserted Then 216 | p1.Characters(p1.Characters.Count).Delete 217 | p2.Characters(p2.Characters.Count).Delete 218 | End If 219 | End Sub 220 | 221 | ' 222 | ' Copies fundamental font attributes from f2 to f1. 223 | ' 224 | Private Sub copyFontAttributes(f1 As Font, f2 As Font) 225 | f1.Name = f2.Name 226 | f1.Size = f2.Size 227 | f1.Bold = f2.Bold 228 | f1.Italic = f2.Italic 229 | f1.Underline = f2.Underline 230 | ' Warning: assigning just one between the Subscript and the Superscript 231 | ' attributes, even to the msoFalse value, may impact the other. Therefore 232 | ' these attributes must be assigned only when strictly required. 233 | If f2.Subscript Then f1.Subscript = msoTrue 234 | If f2.Superscript Then f1.Superscript = msoTrue 235 | If Not f2.Subscript And Not f2.Superscript Then 236 | f1.Subscript = msoFalse 237 | f1.Superscript = msoFalse 238 | End If 239 | assignColor f1.Color, f2.Color 240 | End Sub 241 | 242 | ' 243 | ' This subroutine applies the ZOrder (depth) of shapes in s2 to shapes in s1. 244 | ' Corresponding shapes in s1 and in s2 are different objects, therefore, in order 245 | ' to be matched, shape IDs must have been copied in advance to a shape property 246 | ' that is more persistent by using the copyShapeIds subroutine. 247 | ' Note: the algorithm used to sort shapes in s2 by increasing ZOrder could be 248 | ' improved. 249 | ' 250 | Private Sub matchZOrder(s1 As Slide, s2 As Slide) 251 | Dim sortedShapes(255) As Shape 252 | ProgressForm.infoLabel = "Matching shape Z order..." 253 | ProgressForm.Repaint 254 | zThreshold = 0 255 | j = 1 256 | For i = 1 To s2.Shapes.Count 257 | minZ = 65536 258 | ' Find shape in s2 with minimum ZOrder greater than zThreshold 259 | For Each sh2 In s2.Shapes 260 | ' Inequalities are strict because there should be no 261 | ' two shapes with the same ZOrder 262 | If sh2.ZOrderPosition < minZ And sh2.ZOrderPosition > zThreshold Then 263 | minZ = sh2.ZOrderPosition 264 | minZshapeId = sh2.Tags("shapeId") 265 | End If 266 | Next sh2 267 | zThreshold = minZ 268 | shapeIdInS1 = findShape(s1, minZshapeId) 269 | If shapeIdInS1 > 0 Then 270 | ' The same shape exists also in s1: add the shape to the array of sorted shapes 271 | Set sortedShapes(j) = s1.Shapes(shapeIdInS1) 272 | j = j + 1 273 | End If 274 | Next i 275 | 276 | ' Bring to front shapes in s1 by increasing values of ZOrder 277 | For i = 1 To j - 1 278 | sortedShapes(i).ZOrder msoBringToFront 279 | Next i 280 | ProgressForm.infoLabel = "" 281 | ProgressForm.Repaint 282 | End Sub 283 | 284 | 285 | ' 286 | ' This subroutine deletes a shape from a slide. If the shape is a textbox 287 | ' and its paragraphs are animated independently from each other, then only 288 | ' the affected paragraph will be deleted. It takes as input the affected 289 | ' shape, a timeline and the index of the effect to be removed from the timeline. 290 | ' The returned value is true if and only if the function also deleted the 291 | ' effect (besides the shape or paragraph). 292 | ' 293 | Private Function deleteShape(sh As Shape, theTimeline As Sequence, effectId) 294 | theParagraph = getEffectParagraph(theTimeline(effectId)) 295 | If theParagraph > 0 Then 296 | ' This appears to be a text paragraph effect 297 | oldCount = theTimeline.Count 298 | If oldCount > effectId Then 299 | ' There are other effects following this one. 300 | ' Save the trigger type of the next effect for restoring it later 301 | animType = theTimeline(effectId + 1).Timing.TriggerType 302 | End If 303 | ' Delete (or better, hide) the paragraph 304 | clearParagraph sh, theParagraph 305 | If theTimeline.Count < oldCount Then 306 | ' The removed paragraph was not the last one in the shape, and therefore 307 | ' the effect has been automatically removed. Restore the trigger 308 | ' type if required 309 | If theTimeline.Count >= effectId Then 310 | ' Restore the trigger type 311 | theTimeline(effectId).Timing.TriggerType = animType 312 | End If 313 | deleteShape = True 314 | Else 315 | ' The removed paragraph was the last one in the shape, therefore 316 | ' the effect is still there. 317 | deleteShape = False 318 | End If 319 | Else 320 | ' Whole shape effect 321 | sh.Delete 322 | deleteShape = True 323 | End If 324 | End Function 325 | 326 | ' 327 | ' This subroutine assigns the color in the ColorFormat object 328 | ' col2 to the ColorFormat object col1. 329 | ' Care must be taken in that the color may be specified as an 330 | ' index referring to the slide color scheme or as an RGB value. 331 | ' 332 | Private Sub assignColor(col1 As ColorFormat, col2 As ColorFormat) 333 | If col2.Type <> msoColorTypeRGB Then 334 | ' I must protect from invalid assignments of color 335 | ' scheme indexes. 336 | On Error Resume Next 337 | col1.SchemeColor = col2.SchemeColor 338 | ' The brightness attribute does not seem to be accessible 339 | ' in PowerPoint releases prior to 2010, so we are not setting 340 | ' it here. 341 | On Error GoTo 0 342 | Else 343 | col1.RGB = col2.RGB 344 | End If 345 | End Sub 346 | 347 | ' 348 | ' This subroutine converts a color value from the RGB space to the 349 | ' HSL space. The result will be put in the last 3 arguments. 350 | ' The procedure is taken from http://en.wikipedia.org/wiki/HSL_and_HSV#Conversion_from_RGB_to_HSL_overview 351 | ' 352 | Private Sub RGBtoHSL(r, g, b, h, s, l) 353 | max = 0: min = 255 354 | r = r / 255: g = g / 255: b = b / 255 355 | If r > max Then max = r 356 | If g > max Then max = g 357 | If b > max Then max = b 358 | If r < min Then min = r 359 | If g < min Then min = g 360 | If b < min Then min = b 361 | If max = min Then 362 | h = 0 363 | ElseIf max = r Then 364 | h = (60 * (g - b) / (max - min) + 360) Mod 360 365 | ElseIf max = g Then 366 | h = 60 * (b - r) / (max - min) + 120 367 | ElseIf max = b Then 368 | h = 60 * (r - g) / (max - min) + 240 369 | End If 370 | l = (max + min) / 2 371 | If max = min Then 372 | s = 0 373 | ElseIf l <= 1 / 2 Then 374 | s = (max - min) / (2 * l) 375 | ElseIf l > 1 / 2 Then 376 | s = (max - min) / (2 - 2 * l) 377 | End If 378 | End Sub 379 | 380 | ' 381 | ' This subroutine converts a color value from the HSL space to the 382 | ' RGB space. The result will be put in the last 3 arguments. 383 | ' The procedure is taken from http://en.wikipedia.org/wiki/HSL_and_HSV#Conversion_from_RGB_to_HSL_overview 384 | ' 385 | Private Sub HSLtoRGB(h, s, l, r, g, b) 386 | If l < 1 / 2 Then 387 | q = l * (1 + s) 388 | Else 389 | q = l + s - l * s 390 | End If 391 | p = 2 * l - q 392 | hk = h / 360 393 | tr = hk + 1 / 3 394 | ' Cannot use the Mod operator here, as it only supports integer arithmetic 395 | If tr < 0 Then tr = tr + 1 396 | If tr > 1 Then tr = tr - 1 397 | tg = hk 398 | If tg < 0 Then tg = tg + 1 399 | If tg > 1 Then tg = tg - 1 400 | tb = hk - 1 / 3 401 | If tb < 0 Then tb = tb + 1 402 | If tb > 1 Then tb = tb - 1 403 | 404 | If tr < 1 / 6 Then 405 | r = p + ((q - p) * 6 * tr) 406 | ElseIf tr >= 1 / 6 And tr < 1 / 2 Then 407 | r = q 408 | ElseIf tr >= 1 / 2 And tr < 2 / 3 Then 409 | r = p + ((q - p) * 6 * (2 / 3 - tr)) 410 | Else 411 | r = p 412 | End If 413 | If tg < 1 / 6 Then 414 | g = p + ((q - p) * 6 * tg) 415 | ElseIf tg >= 1 / 6 And tg < 1 / 2 Then 416 | g = q 417 | ElseIf tg >= 1 / 2 And tg < 2 / 3 Then 418 | g = p + ((q - p) * 6 * (2 / 3 - tg)) 419 | Else 420 | g = p 421 | End If 422 | If tb < 1 / 6 Then 423 | b = p + ((q - p) * 6 * tb) 424 | ElseIf tb >= 1 / 6 And tb < 1 / 2 Then 425 | b = q 426 | ElseIf tb >= 1 / 2 And tb < 2 / 3 Then 427 | b = p + ((q - p) * 6 * (2 / 3 - tb)) 428 | Else 429 | b = p 430 | End If 431 | r = r * 255: g = g * 255: b = b * 255 432 | End Sub 433 | 434 | ' 435 | ' This subroutine converts a color value represented by VBA as a Long 436 | ' integer into its RGB components. The result is put in the last 437 | ' 3 arguments of the subroutine. 438 | ' 439 | Private Sub colToRGB(col, r, g, b) 440 | r = col Mod 256 441 | g = (col \ 256) Mod 256 442 | b = (col \ 256 \ 256) Mod 256 443 | End Sub 444 | 445 | ' 446 | ' This subroutine "rotates" the hue of a given color of the 447 | ' specified angle (in degrees). 448 | ' 449 | Private Sub rotateColor(col As ColorFormat, rot) 450 | colToRGB col.RGB, r, g, b 451 | RGBtoHSL r, g, b, h, s, l 452 | h = (h + rot) Mod 360 453 | HSLtoRGB h, s, l, r, g, b 454 | col.RGB = RGB(r, g, b) 455 | End Sub 456 | 457 | ' 458 | ' This subroutine alters the lightness of a given color. 459 | ' The amount should be between 0 and 1. 460 | ' 461 | Private Sub changeLightness(col As ColorFormat, amount) 462 | colToRGB col.RGB, r, g, b 463 | RGBtoHSL r, g, b, h, s, l 464 | l = l + amount 465 | If l > 1 Then l = 1 466 | If l < 0 Then l = 0 467 | HSLtoRGB h, s, l, r, g, b 468 | col.RGB = RGB(r, g, b) 469 | End Sub 470 | 471 | ' 472 | ' After a motion effect has been applied to a shape, the coordinates 473 | ' of all subsequent motion effects have been moved together with the 474 | ' shape. This subroutine applies a given shift to the arrival 475 | ' coordinates (indeed, arrival coordinates is all I need to update) 476 | ' of all the other motion effects for the same shape. Arguments 477 | ' effectSequence (the sequence of effects applied to the shape) and 478 | ' sh (the affected shape) do not need, and in general do not, refer 479 | ' to the same slide. 480 | ' 481 | ' A motion path is specified in VML. Information about the specification 482 | ' can be found here: http://www.w3.org/TR/NOTE-VML#_Toc416858391 483 | ' 484 | Private Sub shiftAllMotions(effectSequence As Sequence, sh As Shape, shiftX, shiftY) 485 | Dim currentEffect As Effect, lastX As Double, lastY As Double 486 | For Each currentEffect In effectSequence 487 | ' The following variable is where I will put the reconstructed 488 | ' path with updated arrival coordinates 489 | motionPathString$ = "" 490 | ' Keep in mind that sh is a shape the effect is applied to (therefore 491 | ' it comes from a certain slide), while effectSequence is the sequence of effects 492 | ' under consideration (which comes from a different slide). Therefore, 493 | ' operator "Is" cannot be used to match the shapes whose motion effects 494 | ' should be updated. 495 | If isPathEffect(currentEffect) And currentEffect.Shape.Tags("shapeId") = sh.Tags("shapeId") Then 496 | ' This is a motion effect applied to the shape under consideration 497 | motionPathTokens = Split(currentEffect.Behaviors(1).MotionEffect.Path) 498 | ' The first character states this is a path motion, therefore I preserve it 499 | motionPathString$ = motionPathString$ + Trim(motionPathTokens(0)) + " " 500 | If currentEffect.Behaviors(1).Timing.Speed < 0 Then 501 | ' The path has been reversed: update origin coordinates instead 502 | lastX = localizeDecimalSeparators(motionPathTokens(1)) 503 | lastY = localizeDecimalSeparators(motionPathTokens(2)) 504 | lastX = lastX + shiftX 505 | lastY = lastY + shiftY 506 | motionPathString$ = motionPathString$ + Trim(Str$(lastX)) + " " + Trim(Str$(lastY)) + " " 507 | ' Append the rest of the motion string 508 | For i = 3 To UBound(motionPathTokens) 509 | motionPathString$ = motionPathString$ + motionPathTokens(i) + " " 510 | Next i 511 | Else 512 | ' Update the last two (i.e., arrival) coordinates 513 | getLastCoordinates currentEffect.Behaviors(1).MotionEffect.Path, lastX, lastY, lastToken 514 | lastX = lastX + shiftX 515 | lastY = lastY + shiftY 516 | ' Copy everything but the last two coordinates from the original 517 | ' motion string 518 | For i = 0 To lastToken 519 | motionPathString$ = motionPathString$ + motionPathTokens(i) + " " 520 | Next i 521 | ' Append the modified coordinates 522 | motionPathString$ = motionPathString$ + Trim(Str$(lastX)) + " " + Trim(Str$(lastY)) + " " 523 | End If 524 | ' Assign the new path 525 | currentEffect.Behaviors(1).MotionEffect.Path = motionPathString$ 526 | End If 527 | Next currentEffect 528 | End Sub 529 | 530 | ' 531 | ' This converts an angle from degrees to radians. At the 532 | ' same time, since shape rotation angles are computed in PowerPoint 533 | ' starting from the positive Y semiaxis and going in 534 | ' clockwise direction, it reverses the convention by returning 535 | ' an angle in radiants that starts from the positive X semiaxis 536 | ' and goes counterclockwise. 537 | ' 538 | Private Function degToRad(degAngle) As Double 539 | degToRad = 3.14159265358979 * ((360 - degAngle) Mod 360) / 180 540 | End Function 541 | 542 | ' 543 | ' This subroutine gets the last (i.e., arrival) coordinates from 544 | ' a string describing a motion path. Extracted coordinates are put 545 | ' in lastX and lastY, while lastTokenBeforeCoordinates will be 546 | ' updated with the index of the token in pathString$ that precedes 547 | ' the last coordinates. 548 | ' 549 | Private Sub getLastCoordinates(pathString$, lastX As Double, lastY As Double, lastTokenBeforeCoordinates) 550 | pathStringTokens = Split(pathString$) 551 | tokenIndex = UBound(pathStringTokens) 552 | While tokenIndex > 0 553 | If pathStringTokens(tokenIndex) <> "" And _ 554 | Not (Mid$(pathStringTokens(tokenIndex), 1, 1) >= "A" And _ 555 | Mid$(pathStringTokens(tokenIndex), 1, 1) <= "Z") Then 556 | lastY = localizeDecimalSeparators(pathStringTokens(tokenIndex)) 557 | lastX = localizeDecimalSeparators(pathStringTokens(tokenIndex - 1)) 558 | lastTokenBeforeCoordinates = tokenIndex - 2 559 | Exit Sub 560 | End If 561 | tokenIndex = tokenIndex - 1 562 | Wend 563 | End Sub 564 | 565 | 566 | ' 567 | ' This subroutine does what it says: it applies an emphasis 568 | ' (or motion) effect to a shape. Arguments are: the sequence of 569 | ' effects (which will only be used to update motion path coordinates), 570 | ' the emphasis effect to be applied, and the shape it applies to 571 | ' 572 | Private Sub applyEmphasisEffect(seq As Sequence, e As Effect, sh As Shape) 573 | On Error GoTo recover 574 | ePar = getEffectParagraph(e) 575 | ' Here I should be supposed to check the value of 576 | ' e.Shape.HasTextFrame before attemping to access 577 | ' the sh.TextFrame.TextRange property. Guess what? 578 | ' In some cases PowerPoint returns false even if 579 | ' properties like sh.TextFrame.TextRange.Font.Size 580 | ' can be accessed. Is it me or could this be yet 581 | ' another bug? 582 | ' Worked around by attempting assignments anyway, and 583 | ' watching for errors during the process. 584 | On Error Resume Next 585 | shTextRange = Null 586 | If ePar > 0 Then 587 | ' This effect applies to a text paragraph 588 | Set shTextRange = sh.TextFrame.TextRange.Paragraphs(ePar) 589 | Else 590 | Set shTextRange = sh.TextFrame.TextRange 591 | End If 592 | On Error GoTo recover 593 | ' Note: if an effect acts both on a text element and on its container 594 | ' shape, then the effect must first be applied to the container shape, 595 | ' in order to avoid unpredictable automatic resizing. 596 | If e.EffectType = msoAnimEffectGrowShrink Then 597 | If e.Shape.Type = msoPlaceholder Or e.EffectInformation.AnimateBackground Or Not e.Shape.TextFrame.HasText Or e.Shape.Type = msoGroup Then 598 | ' I am not scaling a bitmap here, therefore I need to 599 | ' recompute map X and Y scaling in accordance with the shape 600 | ' rotation. 601 | rotCos = Cos(degToRad(sh.Rotation)) 602 | rotSin = Sin(degToRad(sh.Rotation)) 603 | scaleX = e.Behaviors(1).ScaleEffect.ByX / 100 * Abs(rotCos) + e.Behaviors(1).ScaleEffect.ByY / 100 * Abs(rotSin) 604 | scaleY = e.Behaviors(1).ScaleEffect.ByX / 100 * Abs(rotSin) + e.Behaviors(1).ScaleEffect.ByY / 100 * Abs(rotCos) 605 | ' Disable size autofitting for text frames and unlock 606 | ' aspect ratio 607 | sh.LockAspectRatio = msoFalse 608 | On Error Resume Next 609 | sh.TextFrame.AutoSize = ppAutoSizeNone 610 | On Error GoTo recover 611 | sh.ScaleWidth scaleX, msoFalse, msoScaleFromMiddle 612 | sh.ScaleHeight scaleY, msoFalse, msoScaleFromMiddle 613 | End If 614 | ' Font effects may be applied to a group. In that case, 615 | ' at least for versions of PowerPoint prior to 2007, we 616 | ' are forced to apply the effect for each member of the 617 | ' group. 618 | shapeId = 1 619 | If sh.Type = msoGroup Then 620 | shTextRange = Null 621 | On Error Resume Next 622 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 623 | On Error GoTo recover 624 | End If 625 | Do 626 | If Not IsNull(shTextRange) Then 627 | shTextRange.Font.Size = shTextRange.Font.Size * (e.Behaviors(1).ScaleEffect.ByX / 100 + e.Behaviors(1).ScaleEffect.ByY / 100) / 2 628 | End If 629 | shapeId = shapeId + 1 630 | If sh.Type = msoGroup Then 631 | If shapeId > sh.GroupItems.Count Then 632 | shapeId = 0 633 | Else 634 | shTextRange = Null 635 | On Error Resume Next 636 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 637 | On Error GoTo recover 638 | End If 639 | Else 640 | shapeId = 0 641 | End If 642 | Loop Until shapeId = 0 643 | ElseIf e.EffectType = msoAnimEffectChangeFontColor Then 644 | ' Font effects may be applied to a group. In that case, 645 | ' at least for versions of PowerPoint prior to 2007, we 646 | ' are forced to apply the effect for each member of the 647 | ' group. 648 | shapeId = 1 649 | If sh.Type = msoGroup Then 650 | shTextRange = Null 651 | On Error Resume Next 652 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 653 | On Error GoTo recover 654 | End If 655 | Do 656 | If Not IsNull(shTextRange) Then 657 | assignColor shTextRange.Font.Color, e.EffectParameters.Color2 658 | End If 659 | shapeId = shapeId + 1 660 | If sh.Type = msoGroup Then 661 | If shapeId > sh.GroupItems.Count Then 662 | shapeId = 0 663 | Else 664 | shTextRange = Null 665 | On Error Resume Next 666 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 667 | On Error GoTo recover 668 | End If 669 | Else 670 | shapeId = 0 671 | End If 672 | Loop Until shapeId = 0 673 | ElseIf e.EffectType = msoAnimEffectChangeFillColor Then 674 | If sh.Fill.Transparency < 1 Then 675 | sh.Fill.Solid 676 | End If 677 | assignColor sh.Fill.ForeColor, e.EffectParameters.Color2 678 | ElseIf e.EffectType = msoAnimEffectChangeFontStyle Then 679 | ' Font effects may be applied to a group. In that case, 680 | ' at least for versions of PowerPoint prior to 2007, we 681 | ' are forced to apply the effect for each member of the 682 | ' group. 683 | shapeId = 1 684 | If sh.Type = msoGroup Then 685 | shTextRange = Null 686 | On Error Resume Next 687 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 688 | On Error GoTo recover 689 | End If 690 | Do 691 | If Not IsNull(shTextRange) Then 692 | shTextRange.Font.Italic = (e.Behaviors(1).SetEffect.To = 1) 693 | shTextRange.Font.Bold = (e.Behaviors(2).SetEffect.To = 1) 694 | shTextRange.Font.Underline = (e.Behaviors(3).SetEffect.To = 1) 695 | End If 696 | shapeId = shapeId + 1 697 | If sh.Type = msoGroup Then 698 | If shapeId > sh.GroupItems.Count Then 699 | shapeId = 0 700 | Else 701 | shTextRange = Null 702 | On Error Resume Next 703 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 704 | On Error GoTo recover 705 | End If 706 | Else 707 | shapeId = 0 708 | End If 709 | Loop Until shapeId = 0 710 | ElseIf e.EffectType = msoAnimEffectTransparency Then 711 | If e.Shape.Type = msoPlaceholder Or e.EffectInformation.AnimateBackground Or Not e.Shape.TextFrame.HasText Or e.Shape.Type = msoGroup Then 712 | If sh.Line.Transparency < 1 Then 713 | sh.Line.Transparency = e.EffectParameters.amount 714 | End If 715 | If sh.Fill.Transparency < 1 Then 716 | sh.Fill.Transparency = e.EffectParameters.amount 717 | End If 718 | End If 719 | ' Only Office 2007 or newer exposes text font transparency 720 | ' in VBA, therefore this piece of code has been removed. 721 | ElseIf e.EffectType = msoAnimEffectChangeFont Then 722 | ' Font effects may be applied to a group. In that case, 723 | ' at least for versions of PowerPoint prior to 2007, we 724 | ' are forced to apply the effect for each member of the 725 | ' group. 726 | shapeId = 1 727 | If sh.Type = msoGroup Then 728 | shTextRange = Null 729 | On Error Resume Next 730 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 731 | On Error GoTo recover 732 | End If 733 | Do 734 | If Not IsNull(shTextRange) Then 735 | shTextRange.Font.Name = e.EffectParameters.FontName 736 | End If 737 | shapeId = shapeId + 1 738 | If sh.Type = msoGroup Then 739 | If shapeId > sh.GroupItems.Count Then 740 | shapeId = 0 741 | Else 742 | shTextRange = Null 743 | On Error Resume Next 744 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 745 | On Error GoTo recover 746 | End If 747 | Else 748 | shapeId = 0 749 | End If 750 | Loop Until shapeId = 0 751 | ElseIf e.EffectType = msoAnimEffectChangeLineColor Then 752 | If Not sh.Line.Visible Then sh.Line.Visible = msoTrue 753 | assignColor sh.Line.ForeColor, e.EffectParameters.Color2 754 | ElseIf e.EffectType = msoAnimEffectChangeFontSize Then 755 | ' Font effects may be applied to a group. In that case, 756 | ' at least for versions of PowerPoint prior to 2007, we 757 | ' are forced to apply the effect for each member of the 758 | ' group. 759 | shapeId = 1 760 | If sh.Type = msoGroup Then 761 | shTextRange = Null 762 | On Error Resume Next 763 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 764 | On Error GoTo recover 765 | End If 766 | Do 767 | If Not IsNull(shTextRange) Then 768 | ' Please leave the /1 alone: it is required for some strange internal 769 | ' type conversion, otherwise leading to improper font sizes :-( 770 | shTextRange.Font.Size = shTextRange.Font.Size * e.Behaviors(1).PropertyEffect.To / 1 771 | End If 772 | shapeId = shapeId + 1 773 | If sh.Type = msoGroup Then 774 | If shapeId > sh.GroupItems.Count Then 775 | shapeId = 0 776 | Else 777 | shTextRange = Null 778 | On Error Resume Next 779 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 780 | On Error GoTo recover 781 | End If 782 | Else 783 | shapeId = 0 784 | End If 785 | Loop Until shapeId = 0 786 | ElseIf e.EffectType = msoAnimEffectSpin Then 787 | ' Rotating just the text is not supported 788 | sh.Rotation = sh.Rotation + e.Behaviors(1).RotationEffect.By 789 | ElseIf e.EffectType = msoAnimEffectDesaturate Then 790 | If e.Shape.Type = msoPlaceholder Or e.EffectInformation.AnimateBackground Or Not e.Shape.TextFrame.HasText Or e.Shape.Type = msoGroup Then 791 | If sh.Fill.Transparency < 1 Then 792 | With sh.Fill.ForeColor 793 | colToRGB .RGB, r, g, b 794 | .RGB = RGB((r + g + b) / 3, (r + g + b) / 3, (r + g + b) / 3) 795 | End With 796 | With sh.Fill.BackColor 797 | colToRGB .RGB, r, g, b 798 | .RGB = RGB((r + g + b) / 3, (r + g + b) / 3, (r + g + b) / 3) 799 | End With 800 | End If 801 | If sh.Line.Transparency < 1 Then 802 | With sh.Line.ForeColor 803 | colToRGB .RGB, r, g, b 804 | .RGB = RGB((r + g + b) / 3, (r + g + b) / 3, (r + g + b) / 3) 805 | End With 806 | End If 807 | End If 808 | ' Font effects may be applied to a group. In that case, 809 | ' at least for versions of PowerPoint prior to 2007, we 810 | ' are forced to apply the effect for each member of the 811 | ' group. 812 | shapeId = 1 813 | If sh.Type = msoGroup Then 814 | shTextRange = Null 815 | On Error Resume Next 816 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 817 | On Error GoTo recover 818 | End If 819 | Do 820 | If Not IsNull(shTextRange) Then 821 | With shTextRange.Font.Color 822 | colToRGB .RGB, r, g, b 823 | .RGB = RGB((r + g + b) / 3, (r + g + b) / 3, (r + g + b) / 3) 824 | End With 825 | End If 826 | shapeId = shapeId + 1 827 | If sh.Type = msoGroup Then 828 | If shapeId > sh.GroupItems.Count Then 829 | shapeId = 0 830 | Else 831 | shTextRange = Null 832 | On Error Resume Next 833 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 834 | On Error GoTo recover 835 | End If 836 | Else 837 | shapeId = 0 838 | End If 839 | Loop Until shapeId = 0 840 | ElseIf e.EffectType = msoAnimEffectColorWave Or e.EffectType = msoAnimEffectColorBlend Or _ 841 | e.EffectType = msoAnimEffectBrushOnColor Or e.EffectType = msoAnimEffectTeeter Then 842 | If e.Shape.Type = msoPlaceholder Or e.EffectInformation.AnimateBackground Or Not e.Shape.TextFrame.HasText Or e.Shape.Type = msoGroup Then 843 | If sh.Fill.Transparency < 1 Then 844 | assignColor sh.Fill.ForeColor, e.EffectParameters.Color2 845 | End If 846 | End If 847 | ' Font effects may be applied to a group. In that case, 848 | ' at least for versions of PowerPoint prior to 2007, we 849 | ' are forced to apply the effect for each member of the 850 | ' group. 851 | shapeId = 1 852 | If sh.Type = msoGroup Then 853 | shTextRange = Null 854 | On Error Resume Next 855 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 856 | On Error GoTo recover 857 | End If 858 | Do 859 | If Not IsNull(shTextRange) Then 860 | assignColor shTextRange.Font.Color, e.EffectParameters.Color2 861 | End If 862 | shapeId = shapeId + 1 863 | If sh.Type = msoGroup Then 864 | If shapeId > sh.GroupItems.Count Then 865 | shapeId = 0 866 | Else 867 | shTextRange = Null 868 | On Error Resume Next 869 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 870 | On Error GoTo recover 871 | End If 872 | Else 873 | shapeId = 0 874 | End If 875 | Loop Until shapeId = 0 876 | ElseIf e.EffectType = msoAnimEffectComplementaryColor2 Then 877 | ' PowerPoint computes the complementary color in some other way. 878 | ' I feel pretty satisfied with this rotation in the HSL space 879 | If e.Shape.Type = msoPlaceholder Or e.EffectInformation.AnimateBackground Or Not e.Shape.TextFrame.HasText Or e.Shape.Type = msoGroup Then 880 | If sh.Fill.Transparency < 1 Then 881 | rotateColor sh.Fill.ForeColor, 180 882 | End If 883 | If sh.Line.Transparency < 1 Then 884 | rotateColor sh.Line.ForeColor, 180 885 | End If 886 | End If 887 | ElseIf e.EffectType = msoAnimEffectVerticalGrow Then 888 | ' Font scaling alone is not supported for this effect 889 | 890 | ' Disable size autofitting for text frames and unlock 891 | ' aspect ratio 892 | sh.LockAspectRatio = msoFalse 893 | On Error Resume Next 894 | sh.TextFrame.AutoSize = ppAutoSizeNone 895 | On Error GoTo recover 896 | sh.ScaleHeight 1.5, msoFalse 897 | shiftY = sh.Height / 4 898 | If sh.Fill.Transparency < 1 Then 899 | assignColor sh.Fill.ForeColor, e.EffectParameters.Color2 900 | End If 901 | sh.Top = sh.Top - shiftY 902 | ' Font effects may be applied to a group. In that case, 903 | ' at least for versions of PowerPoint prior to 2007, we 904 | ' are forced to apply the effect for each member of the 905 | ' group. 906 | shapeId = 1 907 | If sh.Type = msoGroup Then 908 | shTextRange = Null 909 | On Error Resume Next 910 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 911 | On Error GoTo recover 912 | End If 913 | Do 914 | If Not IsNull(shTextRange) Then 915 | assignColor shTextRange.Font.Color, e.EffectParameters.Color2 916 | End If 917 | shapeId = shapeId + 1 918 | If sh.Type = msoGroup Then 919 | If shapeId > sh.GroupItems.Count Then 920 | shapeId = 0 921 | Else 922 | shTextRange = Null 923 | On Error Resume Next 924 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 925 | On Error GoTo recover 926 | End If 927 | Else 928 | shapeId = 0 929 | End If 930 | Loop Until shapeId = 0 931 | ElseIf e.EffectType = msoAnimEffectLighten Then 932 | If e.Shape.Type = msoPlaceholder Or e.EffectInformation.AnimateBackground Or Not e.Shape.TextFrame.HasText Or e.Shape.Type = msoGroup Then 933 | If sh.Fill.Transparency < 1 Then 934 | changeLightness sh.Fill.ForeColor, 0.3 935 | End If 936 | If sh.Line.Transparency < 1 Then 937 | changeLightness sh.Line.ForeColor, 0.3 938 | End If 939 | End If 940 | ' Font effects may be applied to a group. In that case, 941 | ' at least for versions of PowerPoint prior to 2007, we 942 | ' are forced to apply the effect for each member of the 943 | ' group. 944 | shapeId = 1 945 | If sh.Type = msoGroup Then 946 | shTextRange = Null 947 | On Error Resume Next 948 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 949 | On Error GoTo recover 950 | End If 951 | Do 952 | If Not IsNull(shTextRange) Then 953 | changeLightness shTextRange.Font.Color, 0.3 954 | End If 955 | shapeId = shapeId + 1 956 | If sh.Type = msoGroup Then 957 | If shapeId > sh.GroupItems.Count Then 958 | shapeId = 0 959 | Else 960 | shTextRange = Null 961 | On Error Resume Next 962 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 963 | On Error GoTo recover 964 | End If 965 | Else 966 | shapeId = 0 967 | End If 968 | Loop Until shapeId = 0 969 | ElseIf e.EffectType = msoAnimEffectBrushOnUnderline Then 970 | ' Font effects may be applied to a group. In that case, 971 | ' at least for versions of PowerPoint prior to 2007, we 972 | ' are forced to apply the effect for each member of the 973 | ' group. 974 | shapeId = 1 975 | If sh.Type = msoGroup Then 976 | shTextRange = Null 977 | On Error Resume Next 978 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 979 | On Error GoTo recover 980 | End If 981 | Do 982 | If Not IsNull(shTextRange) Then 983 | shTextRange.Font.Underline = msoTrue 984 | End If 985 | shapeId = shapeId + 1 986 | If sh.Type = msoGroup Then 987 | If shapeId > sh.GroupItems.Count Then 988 | shapeId = 0 989 | Else 990 | shTextRange = Null 991 | On Error Resume Next 992 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 993 | On Error GoTo recover 994 | End If 995 | Else 996 | shapeId = 0 997 | End If 998 | Loop Until shapeId = 0 999 | ElseIf e.EffectType = msoAnimEffectComplementaryColor Then 1000 | ' PowerPoint computes the complementary color in some other way. 1001 | ' I feel pretty satisfied with this rotation in the HSL space 1002 | If e.Shape.Type = msoPlaceholder Or e.EffectInformation.AnimateBackground Or Not e.Shape.TextFrame.HasText Or e.Shape.Type = msoGroup Then 1003 | If sh.Fill.Transparency < 1 Then 1004 | rotateColor sh.Fill.ForeColor, 120 1005 | End If 1006 | If sh.Line.Transparency < 1 Then 1007 | rotateColor sh.Line.ForeColor, 120 1008 | End If 1009 | End If 1010 | ElseIf e.EffectType = msoAnimEffectContrastingColor Then 1011 | ' PowerPoint computes the contrasting color in some other way. 1012 | ' I feel pretty satisfied with this rotation in the HSL space 1013 | If e.Shape.Type = msoPlaceholder Or e.EffectInformation.AnimateBackground Or Not e.Shape.TextFrame.HasText Or e.Shape.Type = msoGroup Then 1014 | If sh.Fill.Transparency < 1 Then 1015 | rotateColor sh.Fill.ForeColor, 90 1016 | End If 1017 | If sh.Line.Transparency < 1 Then 1018 | rotateColor sh.Line.ForeColor, 90 1019 | End If 1020 | End If 1021 | ElseIf e.EffectType = msoAnimEffectBoldFlash Then 1022 | ' msoAnimEffectBoldFlash is a non-permanent effect 1023 | ElseIf e.EffectType = msoAnimEffectFlashBulb Then 1024 | ' msoAnimEffectFlashBulb is a non-permanent effect 1025 | ElseIf e.EffectType = msoAnimEffectDarken Then 1026 | If e.Shape.Type = msoPlaceholder Or e.EffectInformation.AnimateBackground Or Not e.Shape.TextFrame.HasText Or e.Shape.Type = msoGroup Then 1027 | If sh.Fill.Transparency < 1 Then 1028 | changeLightness sh.Fill.ForeColor, -0.3 1029 | End If 1030 | If sh.Line.Transparency < 1 Then 1031 | changeLightness sh.Line.ForeColor, -0.3 1032 | End If 1033 | End If 1034 | ' Font effects may be applied to a group. In that case, 1035 | ' at least for versions of PowerPoint prior to 2007, we 1036 | ' are forced to apply the effect for each member of the 1037 | ' group. 1038 | shapeId = 1 1039 | If sh.Type = msoGroup Then 1040 | shTextRange = Null 1041 | On Error Resume Next 1042 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 1043 | On Error GoTo recover 1044 | End If 1045 | Do 1046 | If Not IsNull(shTextRange) Then 1047 | changeLightness shTextRange.Font.Color, -0.3 1048 | End If 1049 | shapeId = shapeId + 1 1050 | If sh.Type = msoGroup Then 1051 | If shapeId > sh.GroupItems.Count Then 1052 | shapeId = 0 1053 | Else 1054 | shTextRange = Null 1055 | On Error Resume Next 1056 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 1057 | On Error GoTo recover 1058 | End If 1059 | Else 1060 | shapeId = 0 1061 | End If 1062 | Loop Until shapeId = 0 1063 | ElseIf e.EffectType = msoAnimEffectGrowWithColor Then 1064 | If sh.Fill.Transparency < 1 Then 1065 | sh.Fill.Solid 1066 | assignColor sh.Fill.ForeColor, e.EffectParameters.Color2 1067 | End If 1068 | ' Font effects may be applied to a group. In that case, 1069 | ' at least for versions of PowerPoint prior to 2007, we 1070 | ' are forced to apply the effect for each member of the 1071 | ' group. 1072 | shapeId = 1 1073 | If sh.Type = msoGroup Then 1074 | shTextRange = Null 1075 | On Error Resume Next 1076 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 1077 | On Error GoTo recover 1078 | End If 1079 | Do 1080 | If Not IsNull(shTextRange) Then 1081 | shTextRange.Font.Size = shTextRange.Font.Size * 1.5 1082 | assignColor shTextRange.Font.Color, e.EffectParameters.Color2 1083 | End If 1084 | shapeId = shapeId + 1 1085 | If sh.Type = msoGroup Then 1086 | If shapeId > sh.GroupItems.Count Then 1087 | shapeId = 0 1088 | Else 1089 | shTextRange = Null 1090 | On Error Resume Next 1091 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 1092 | On Error GoTo recover 1093 | End If 1094 | Else 1095 | shapeId = 0 1096 | End If 1097 | Loop Until shapeId = 0 1098 | ElseIf e.EffectType = msoAnimEffectFlicker Then 1099 | ' msoAnimEffectFlicker is a non-permanent effect 1100 | ' *** WARNING: the shaking effect has no associated effecttype (PowerPoint bug :-((( ) 1101 | ElseIf e.EffectType = msoAnimEffectBoldReveal Then 1102 | ' Font effects may be applied to a group. In that case, 1103 | ' at least for versions of PowerPoint prior to 2007, we 1104 | ' are forced to apply the effect for each member of the 1105 | ' group. 1106 | shapeId = 1 1107 | If sh.Type = msoGroup Then 1108 | shTextRange = Null 1109 | On Error Resume Next 1110 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 1111 | On Error GoTo recover 1112 | End If 1113 | Do 1114 | If Not IsNull(shTextRange) Then 1115 | shTextRange.Font.Bold = msoTrue 1116 | End If 1117 | shapeId = shapeId + 1 1118 | If sh.Type = msoGroup Then 1119 | If shapeId > sh.GroupItems.Count Then 1120 | shapeId = 0 1121 | Else 1122 | shTextRange = Null 1123 | On Error Resume Next 1124 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 1125 | On Error GoTo recover 1126 | End If 1127 | Else 1128 | shapeId = 0 1129 | End If 1130 | Loop Until shapeId = 0 1131 | ElseIf e.EffectType = msoAnimEffectWave Then 1132 | ' msoAnimEffectWave is a non-permanent effect 1133 | ElseIf e.EffectType = msoAnimEffectStyleEmphasis Then 1134 | ' Font effects may be applied to a group. In that case, 1135 | ' at least for versions of PowerPoint prior to 2007, we 1136 | ' are forced to apply the effect for each member of the 1137 | ' group. 1138 | shapeId = 1 1139 | If sh.Type = msoGroup Then 1140 | shTextRange = Null 1141 | On Error Resume Next 1142 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 1143 | On Error GoTo recover 1144 | End If 1145 | Do 1146 | If Not IsNull(shTextRange) Then 1147 | shTextRange.Font.Italic = msoTrue 1148 | shTextRange.Font.Bold = msoTrue 1149 | shTextRange.Font.Underline = msoTrue 1150 | assignColor shTextRange.Font.Color, e.EffectParameters.Color2 1151 | End If 1152 | shapeId = shapeId + 1 1153 | If sh.Type = msoGroup Then 1154 | If shapeId > sh.GroupItems.Count Then 1155 | shapeId = 0 1156 | Else 1157 | shTextRange = Null 1158 | On Error Resume Next 1159 | Set shTextRange = sh.GroupItems(shapeId).TextFrame.TextRange 1160 | On Error GoTo recover 1161 | End If 1162 | Else 1163 | shapeId = 0 1164 | End If 1165 | Loop Until shapeId = 0 1166 | ' *** WARNING: the blinking effect has no associated effecttype (PowerPoint bug :-((( ) 1167 | ElseIf e.EffectType = msoAnimEffectBlast Then 1168 | ' msoAnimEffectBlast has too vague a behavior to be implemented :-O 1169 | Else 1170 | If isEmphasisEffect(e) Then 1171 | On Error GoTo 0 1172 | ' Ok, this is neither an emphasis effect nor an entry effect: 1173 | ' it must be a motion effect 1174 | motionpath = Split(e.Behaviors(1).MotionEffect.Path) 1175 | Dim lastX As Double, lastY As Double 1176 | If e.Behaviors(1).Timing.Speed < 0 Then 1177 | lastX = localizeDecimalSeparators(motionpath(1)) 1178 | lastY = localizeDecimalSeparators(motionpath(2)) 1179 | Else 1180 | getLastCoordinates e.Behaviors(1).MotionEffect.Path, lastX, lastY, lastToken 1181 | End If 1182 | ' Coordinates are expressed in VML (see http://www.w3.org/TR/1998/NOTE-VML-19980513#_Toc416858391) 1183 | ' as multiples of the slide width/height and are relative to the shape center 1184 | shapeCenterX = (sh.Left + sh.Width / 2) / ActivePresentation.PageSetup.SlideWidth 1185 | shapeCenterY = (sh.Top + sh.Height / 2) / ActivePresentation.PageSetup.SlideHeight 1186 | newX = (shapeCenterX + lastX) * ActivePresentation.PageSetup.SlideWidth 1187 | newY = (shapeCenterY + lastY) * ActivePresentation.PageSetup.SlideHeight 1188 | sh.Left = newX - sh.Width / 2 1189 | sh.Top = newY - sh.Height / 2 1190 | shiftAllMotions seq, sh, -lastX, -lastY 1191 | End If 1192 | End If 1193 | Exit Sub 1194 | recover: 1195 | ' Ok, Powerpoint bug again: this is an emphasis effect that 1196 | ' has no EffectType member. Let's pass it by. 1197 | End Sub 1198 | 1199 | ' 1200 | ' This function returns true if (and only if) the effect given 1201 | ' as argument is a motion (path) effect 1202 | ' 1203 | Private Function isPathEffect(e As Effect) As Boolean 1204 | On Error GoTo pathRecover 1205 | isPathEffect = False 1206 | ' The following conditions have been built starting from the page "Powerpoint 1207 | ' constants" of the VBA documentation. 1208 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPath5PointStar 1209 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathCrescentMoon 1210 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathSquare 1211 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathTrapezoid 1212 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathHeart 1213 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathOctagon 1214 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPath6PointStar 1215 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathFootball 1216 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathEqualTriangle 1217 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathParallelogram 1218 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathPentagon 1219 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPath4PointStar 1220 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPath8PointStar 1221 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathTeardrop 1222 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathPointyStar 1223 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathCurvedSquare 1224 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathCurvedX 1225 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathVerticalFigure8 1226 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathCurvyStar 1227 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathLoopdeLoop 1228 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathBuzzsaw 1229 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathHorizontalFigure8 1230 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathPeanut 1231 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathFigure8Four 1232 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathNeutron 1233 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathSwoosh 1234 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathBean 1235 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathPlus 1236 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathInvertedTriangle 1237 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathInvertedSquare 1238 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathLeft 1239 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathTurnRight 1240 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathArcDown 1241 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathZigzag 1242 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathSCurve2 1243 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathSineWave 1244 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathBounceLeft 1245 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathDown 1246 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathTurnUp 1247 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathArcUp 1248 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathHeartbeat 1249 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathSpiralRight 1250 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathWave 1251 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathCurvyLeft 1252 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathDiagonalDownRight 1253 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathTurnDown 1254 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathArcLeft 1255 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathFunnel 1256 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathSpring 1257 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathBounceRight 1258 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathSpiralLeft 1259 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathDiagonalUpRight 1260 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathTurnUpRight 1261 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathArcRight 1262 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathSCurve1 1263 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathDecayingWave 1264 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathCurvyRight 1265 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathStairsDown 1266 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathUp 1267 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectPathRight 1268 | 1269 | ' 0 = msoAnimEffectCustom = Customized path 1270 | isPathEffect = isPathEffect Or e.EffectType = msoAnimEffectCustom 1271 | Exit Function 1272 | 1273 | pathRecover: 1274 | ' Powerpoint bug: this effect has no EffectType property; 1275 | ' I cannot either recognize or handle it. At the time of 1276 | ' writing this code, there were no motion effects affected 1277 | ' by this problem, therefore this is not a motion effect. 1278 | isPathEffect = False 1279 | End Function 1280 | 1281 | 1282 | ' 1283 | ' This function returns true iff the given effect is either 1284 | ' an emphasis effect or a motion effect. 1285 | ' 1286 | Private Function isEmphasisEffect(e As Effect) As Boolean 1287 | On Error GoTo recoverIsEmphasis 1288 | isEmphasisEffect = False 1289 | ' The following conditions have been built starting from the page "Powerpoint 1290 | ' constants" of the VBA documentation. 1291 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectGrowShrink 1292 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectChangeFontColor 1293 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectChangeFillColor 1294 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectChangeFontStyle 1295 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectTransparency 1296 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectChangeFont 1297 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectChangeLineColor 1298 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectChangeFontSize 1299 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectSpin 1300 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectDesaturate 1301 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectColorWave 1302 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectComplementaryColor2 1303 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectVerticalGrow 1304 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectLighten 1305 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectColorBlend 1306 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectBrushOnUnderline 1307 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectBrushOnColor 1308 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectComplementaryColor 1309 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectContrastingColor 1310 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectBoldFlash 1311 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectFlashBulb 1312 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectDarken 1313 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectGrowWithColor 1314 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectTeeter 1315 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectFlicker 1316 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectBoldReveal 1317 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectWave 1318 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectStyleEmphasis 1319 | isEmphasisEffect = isEmphasisEffect Or e.EffectType = msoAnimEffectBlast 1320 | 1321 | isEmphasisEffect = isEmphasisEffect Or isPathEffect(e) 1322 | 1323 | ' If isEmphasisEffect is true at this point, then I have 1324 | ' an emphasis or motion effect. But let's really make sure it is not 1325 | ' an entry/exit effect. 1326 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectAppear 1327 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectFly 1328 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectBlinds 1329 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectBox 1330 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectCheckerboard 1331 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectCircle 1332 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectCrawl 1333 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectDiamond 1334 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectDissolve 1335 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectFade 1336 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectFlashOnce 1337 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectPeek 1338 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectPlus 1339 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectRandomBars 1340 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectSpiral 1341 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectSplit 1342 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectStretch 1343 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectStrips 1344 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectSwivel 1345 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectWedge 1346 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectWheel 1347 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectWipe 1348 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectZoom 1349 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectRandomEffects 1350 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectBoomerang 1351 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectBounce 1352 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectColorReveal 1353 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectCredits 1354 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectEaseIn 1355 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectFloat 1356 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectGrowAndTurn 1357 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectLightSpeed 1358 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectPinwheel 1359 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectRiseUp 1360 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectSwish 1361 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectThinLine 1362 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectUnfold 1363 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectWhip 1364 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectAscend 1365 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectCenterRevolve 1366 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectFadedSwivel 1367 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectDescend 1368 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectSling 1369 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectSpinner 1370 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectStretchy 1371 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectZip 1372 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectArcUp 1373 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectFadedZoom 1374 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectGlide 1375 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectExpand 1376 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectFlip 1377 | isEmphasisEffect = isEmphasisEffect And e.EffectType <> msoAnimEffectFold 1378 | Exit Function 1379 | recoverIsEmphasis: 1380 | ' Powerpoint bug: this effect has no EffectType property; 1381 | ' I cannot either recognize or handle it. Luckily enough, 1382 | ' there is no need to process the affected effects because 1383 | ' they are non-permanent (apart from the color that the 1384 | ' shaking effect allows to apply to the shape). Here I 1385 | ' assume that an unrecognizable effect is an emphasis effect. 1386 | isEmphasisEffect = True 1387 | End Function 1388 | ' 1389 | ' This function takes an effect as argument. If the 1390 | ' effect is applied to a text paragraph, it returns the 1391 | ' index of that text paragraph (in its container shape). 1392 | ' Otherwise, it returns -1. 1393 | ' 1394 | Private Function getEffectParagraph(e As Effect) 1395 | paragraph_idx = -1 1396 | On Error Resume Next 1397 | ' The following assignment may fail because the Paragraph property does not 1398 | ' exist at all for those effects that are applied to shapes instead of text. 1399 | ' But, was this truly expected by design? :-? 1400 | paragraph_idx = e.Paragraph 1401 | On Error GoTo 0 1402 | getEffectParagraph = paragraph_idx 1403 | End Function 1404 | 1405 | ' 1406 | ' This subroutine deletes all the shapes for which the first 1407 | ' effect in the sequence is an entry effect. This is reasonable, 1408 | ' because those shapes are expected to appear later on. 1409 | ' 1410 | Private Sub purgeFutureShapes(s As Slide, textParagraphEffectsOnly As Boolean) 1411 | Dim slide_timeline As Sequence 1412 | Set slide_timeline = s.TimeLine.MainSequence 1413 | ProgressForm.infoLabel = "Preprocessing slide effects..." 1414 | ProgressForm.Repaint 1415 | If doNotSplitMouseTriggered Then 1416 | start_deleting_at = 1 1417 | Else 1418 | i = 1: start_deleting_at = 0 1419 | While i <= slide_timeline.Count And start_deleting_at = 0 1420 | If slide_timeline(i).Timing.TriggerType <> msoAnimTriggerAfterPrevious And _ 1421 | slide_timeline(i).Timing.TriggerType <> msoAnimTriggerWithPrevious Then 1422 | ' Start deleting shapes from the next mouse-triggered event. 1423 | ' Any preceding shapes will be deleted when their effects 1424 | ' are individually considered 1425 | start_deleting_at = i 1426 | End If 1427 | i = i + 1 1428 | Wend 1429 | End If 1430 | 1431 | If start_deleting_at > 0 Then 1432 | For i = start_deleting_at To s.TimeLine.MainSequence.Count 1433 | If i > s.TimeLine.MainSequence.Count Then Exit For 1434 | delete_shape_idx = -1 1435 | If Not slide_timeline(i).Exit And Not isEmphasisEffect(slide_timeline(i)) Then 1436 | ' This is an entry effect applied in the future. Likely a candidate 1437 | ' to justify shape deletion 1438 | delete_shape_idx = i 1439 | End If 1440 | parI = getEffectParagraph(slide_timeline(i)) 1441 | For j = i - 1 To start_deleting_at Step -1 1442 | If slide_timeline(i).Shape Is slide_timeline(j).Shape And _ 1443 | (slide_timeline(j).Exit Or isEmphasisEffect(slide_timeline(j))) Then 1444 | ' Probably we need to abort deletion: there may 1445 | ' be an exit/emphasis effect for the same shape before the entry effect. 1446 | ' In that case, this means that the shape must be visible at the 1447 | ' beginning. However, first we need to check if this is a paragraph 1448 | ' effect and, in that case, if the exit/emphasis 1449 | ' effect applies to the very same paragraph. 1450 | parJ = getEffectParagraph(slide_timeline(j)) 1451 | If parI = parJ Then 1452 | ' Either none of the effects is a paragraph effect (in which 1453 | ' case the match is ok because both effects work on the same shape) 1454 | ' or both effects are paragraph effects and work on the same paragraph 1455 | ' (in which case the match is still ok because they affect the 1456 | ' same graphical element). If the match is ok, then deletion 1457 | ' must be aborted. 1458 | delete_shape_idx = -1 1459 | End If 1460 | End If 1461 | Next j 1462 | If delete_shape_idx > 0 Then 1463 | ' Delete shapes for which a following entry effect exists. 1464 | ' Restrict deletion to text paragraphs only if instructed to 1465 | ' do so. 1466 | If parI > 0 Or Not textParagraphEffectsOnly Then 1467 | ' Pay attention, because shape deletion (not paragraph deletion) 1468 | ' causes animation effects to disappear from the timeline, so we 1469 | ' need to decrease i in order to keep in sync with the currently 1470 | ' processed effect. 1471 | ' In general, deletion of a shape may cause several preceding 1472 | ' effects to also disappear: here we count how many in order to 1473 | ' understand how many positions should i go backward (note that 1474 | ' future effects for the same shapes should not be counted, because 1475 | ' they will safely disappear from the timeline without the need 1476 | ' to realign the value of i). 1477 | prevEffectsForThisShape = 0 1478 | For k = 1 To i 1479 | If slide_timeline(k).Shape Is slide_timeline(i).Shape Then 1480 | prevEffectsForThisShape = prevEffectsForThisShape + 1 1481 | End If 1482 | Next k 1483 | ' Assertion: at the end of the above iteration, prevEffectsForThisShape 1484 | ' should always be >0 (because at least the i'th effect affects that 1485 | ' shape) 1486 | If deleteShape(slide_timeline(i).Shape, slide_timeline, delete_shape_idx) Then 1487 | i = i - prevEffectsForThisShape 1488 | End If 1489 | End If 1490 | End If 1491 | Next i 1492 | End If 1493 | ProgressForm.infoLabel = "" 1494 | ProgressForm.Repaint 1495 | End Sub 1496 | 1497 | ' 1498 | ' This function returns the sequential number of a shape in s 1499 | ' that matches the id, or 0 if no such shape exists. The 1500 | ' function relies on the values of the "shapeId" tag, 1501 | ' which must have been set up in advance using the 1502 | ' copyShapeIds subroutine. 1503 | ' 1504 | Private Function findShape(s As Slide, id) 1505 | Dim currentShape As Shape 1506 | i = 1 1507 | findShape = 0 1508 | For Each currentShape In s.Shapes 1509 | If currentShape.Tags("shapeId") = id Then 1510 | findShape = i 1511 | Exit Function 1512 | End If 1513 | i = i + 1 1514 | Next currentShape 1515 | End Function 1516 | 1517 | ' 1518 | ' This subroutine applies to slide s a generic animation effect that is 1519 | ' on top of the timeline of seq_slide. At the same time, it also removes 1520 | ' the effect from the timeline of seq_slide. Returns 0 if behaving normally. 1521 | ' Returns 1 in the exceptional case when an animation effect is added by 1522 | ' the function itself. 1523 | ' 1524 | Private Function applyEffect(s As Slide, seq_slide As Slide) 1525 | Dim current_effect As Effect, sh As Shape 1526 | Set current_effect = seq_slide.TimeLine.MainSequence(1) 1527 | Set sh = current_effect.Shape 1528 | ' By default the applyEffect function only consumes effects, does not add them 1529 | applyEffect = 0 1530 | If current_effect.EffectInformation.AfterEffect = msoAnimAfterEffectHide Then 1531 | ' This effect is set for hiding the shape after the animation, so it 1532 | ' must be treated equivalently to an exit effect: simply delete the shape 1533 | If findShape(s, sh.Tags("shapeId")) > 0 Then 1534 | deleteShape s.Shapes(findShape(s, sh.Tags("shapeId"))), seq_slide.TimeLine.MainSequence, 1 1535 | End If 1536 | current_effect.Delete 1537 | Else 1538 | If current_effect.EffectInformation.AfterEffect = msoAnimAfterEffectHideOnNextClick Then 1539 | ' This effect is set for hiding after the next click: 1540 | ' insert a new exit animation that will be processed in the following 1541 | found = False 1542 | Set tl = seq_slide.TimeLine.MainSequence 1543 | For i = 2 To tl.Count 1544 | If tl(i).Timing.TriggerType = msoAnimTriggerOnPageClick Then 1545 | tl.AddEffect current_effect.Shape, msoAnimEffectDissolve, , msoAnimTriggerWithPrevious 1546 | ' Best thing would be to insert the exit effect right after the next click-triggered 1547 | ' effect, but this is not possible, guess why, due to a PowerPoint bug which causes 1548 | ' the Index argument of AddEffect to be handled unpredictably. So, we need to work this 1549 | ' around by inserting the effect at the end of the sequence and, only afterwards, 1550 | ' move it to the right location. 1551 | tl(tl.Count).MoveTo i + 1 1552 | tl(i + 1).Exit = msoTrue 1553 | found = True 1554 | Exit For 1555 | End If 1556 | Next i 1557 | If Not found Then 1558 | tl.AddEffect current_effect.Shape, msoAnimEffectDissolve, , msoAnimTriggerOnPageClick, i 1559 | tl(i).Exit = msoTrue 1560 | End If 1561 | ' This is the only case when the applyEffect function adds an animation effect to the 1562 | ' sequence: here we notify the calling routine about the fact that the animation sequence 1563 | ' has lengthened. 1564 | applyEffect = 1 1565 | End If 1566 | If current_effect.Timing.RewindAtEnd Then 1567 | ' A rewound-after-the-end animation has no effect (unless it is set for 1568 | ' being hidden after the animation, which has already been checked) 1569 | current_effect.Delete 1570 | Else 1571 | If current_effect.Exit Then 1572 | ' This is an exit effect: simply delete the shape (or the text 1573 | ' paragraph) from the next slide 1574 | If findShape(s, sh.Tags("shapeId")) > 0 Then 1575 | deleteShape s.Shapes(findShape(s, sh.Tags("shapeId"))), seq_slide.TimeLine.MainSequence, 1 1576 | End If 1577 | current_effect.Delete 1578 | Else 1579 | If isEmphasisEffect(current_effect) Then 1580 | ' This is an emphasis (or motion) effect. Note that an autoreversed emphasis 1581 | ' effect has no overall effect. Also, an emphasis effect can never be applied 1582 | ' to a single text paragraph 1583 | If Not current_effect.Timing.AutoReverse Then 1584 | If findShape(s, sh.Tags("shapeId")) > 0 Then 1585 | applyEmphasisEffect seq_slide.TimeLine.MainSequence, seq_slide.TimeLine.MainSequence(1), s.Shapes(findShape(s, sh.Tags("shapeId"))) 1586 | End If 1587 | End If 1588 | current_effect.Delete 1589 | Else 1590 | ' This is an entry effect. 1591 | If Not findShape(s, sh.Tags("shapeId")) > 0 Then 1592 | ' The shape is not already present 1593 | sh.Copy 1594 | ' Invoke purgeEffects to clear any subsequent entry 1595 | ' effects, which may interfere 1596 | ' with calls to purgeFutureShapes below in this same 1597 | ' subroutine. 1598 | ' (note that these subsequent calls may happen when 1599 | ' in the same slide multiple objects appear simultaneously, 1600 | ' and therefore applyEffect is invoked multiple times). 1601 | purgeEffects s 1602 | s.Shapes.Paste 1603 | Set newShape = s.Shapes(findShape(s, sh.Tags("shapeId"))) 1604 | ' Coordinates of the pasted shape are sometimes 1605 | ' automatically adjusted (for example if the shape 1606 | ' overlaps with another one) 1607 | newShape.Left = sh.Left 1608 | newShape.Top = sh.Top 1609 | par = -1 1610 | On Error Resume Next 1611 | ' The following assignment may raise an error for missing 1612 | ' Paragraph property 1613 | par = current_effect.Paragraph 1614 | On Error GoTo 0 1615 | If par > 0 Then 1616 | ' Remove all the paragraphs that are supposed to appear later 1617 | For parIdx = 1 To newShape.TextFrame.TextRange.Paragraphs.Count 1618 | If parIdx <> par Then 1619 | foundEntryAnim = False 1620 | For k = 1 To seq_slide.TimeLine.MainSequence.Count 1621 | If seq_slide.TimeLine.MainSequence(k).Shape Is sh And Not isEmphasisEffect(seq_slide.TimeLine.MainSequence(k)) _ 1622 | And Not seq_slide.TimeLine.MainSequence(k).Exit Then 1623 | On Error Resume Next 1624 | If seq_slide.TimeLine.MainSequence(k).Paragraph = parIdx Then 1625 | foundEntryAnim = True 1626 | End If 1627 | On Error GoTo 0 1628 | End If 1629 | Next k 1630 | If foundEntryAnim Then 1631 | clearParagraph s.Shapes(findShape(s, sh.Tags("shapeId"))), parIdx 1632 | End If 1633 | End If 1634 | Next parIdx 1635 | End If 1636 | ' Sometimes text auto-fitting does not seem to act 1637 | ' properly: this is an attempt to "awaken" it by 1638 | ' notifying of a change in the shape size 1639 | newShape.Width = sh.Width 1640 | newShape.Height = sh.Height 1641 | ' Now we have pasted the shape. Note that we paste 1642 | ' only one shape at a time, therefore it should carry 1643 | ' with itself its own entry effect. There is one 1644 | ' exception: a single text box shape may be associated with 1645 | ' several subsequent entry effects, that correspond 1646 | ' to paragraphs in the text appearing one after the 1647 | ' other (and after the text box itself has appeared). 1648 | ' We should get rid of paragraphs that are supposed 1649 | ' to appear later on, and this is why we call purgeFutureShapes 1650 | ' also here. Note that we should remove the entry effect 1651 | ' for the shape we have just added before invoking 1652 | ' purgeFutureShapes, or the shape itself will be 1653 | ' deleted! 1654 | s.TimeLine.MainSequence(1).Delete 1655 | purgeFutureShapes s, True 1656 | Else 1657 | ' The shape is already present: I only need to add a 1658 | ' paragraph to it, if required. 1659 | par = -1 1660 | ' The following assignment may raise an error for missing 1661 | ' Paragraph property 1662 | On Error Resume Next 1663 | par = current_effect.Paragraph 1664 | On Error GoTo 0 1665 | If par > 0 Then 1666 | Set newShape = s.Shapes(findShape(s, sh.Tags("shapeId"))) 1667 | copyParagraph s.Shapes(findShape(s, sh.Tags("shapeId"))).TextFrame.TextRange.Paragraphs(par), sh.TextFrame.TextRange.Paragraphs(par) 1668 | 1669 | ' Attempt to preserve indentations and margins (these are not 1670 | ' part of paragraph information, but rather of a Ruler object). 1671 | ' In principle, the number of ruler levels (i.e., possible 1672 | ' indentation levels) is fixed. However, according to the documentation 1673 | ' it should be 5 whereas in practice I have seen cases where it 1674 | ' counts up to 9. To stay on the safe side, the number of 1675 | ' ruler levels here is parametric. 1676 | For ruler_level = 1 To sh.TextFrame.Ruler.Levels.Count 1677 | ' For some obscure reasons, out-of-range margins are sometimes 1678 | ' returned (for example, corresponding to the smallest possible 1679 | ' value in a Long variable). In this case, it's better to 1680 | ' refrain from copying the margin value, or an error would be 1681 | ' raised. 1682 | If Abs(sh.TextFrame.Ruler.Levels(ruler_level).FirstMargin) < 10000000 Then 1683 | newShape.TextFrame.Ruler.Levels(ruler_level).FirstMargin = sh.TextFrame.Ruler.Levels(ruler_level).FirstMargin 1684 | End If 1685 | If Abs(sh.TextFrame.Ruler.Levels(ruler_level).LeftMargin) < 10000000 Then 1686 | newShape.TextFrame.Ruler.Levels(ruler_level).LeftMargin = sh.TextFrame.Ruler.Levels(ruler_level).LeftMargin 1687 | End If 1688 | Next ruler_level 1689 | 1690 | ' Sometimes text auto-fitting does not seem to act 1691 | ' properly: this is an attempt to "awaken" it by 1692 | ' notifying of a change in the shape size 1693 | newShape.Width = sh.Width 1694 | newShape.Height = sh.Height 1695 | End If 1696 | End If 1697 | current_effect.Delete 1698 | End If 1699 | End If 1700 | End If 1701 | End If 1702 | End Function 1703 | 1704 | ' 1705 | ' This subroutine removes all the animation effects from a slide. Useful 1706 | ' to leave slides clean after processing 1707 | ' 1708 | Private Sub purgeEffects(s As Slide) 1709 | For i = 1 To s.TimeLine.MainSequence.Count 1710 | s.TimeLine.MainSequence(1).Delete 1711 | Next i 1712 | s.SlideShowTransition.EntryEffect = ppEffectNone 1713 | End Sub 1714 | 1715 | ' 1716 | ' This function copies shape Ids to a less volatile Tag. This is 1717 | ' very useful to match different instances of the same shape in different 1718 | ' slides, as the copy-and-paste process used to implement entry effects 1719 | ' discards the shape id. 1720 | ' 1721 | Private Sub copyShapeIds(s As Slide) 1722 | Dim sh As Shape 1723 | For Each sh In s.Shapes 1724 | sh.Tags.Add "shapeId", Str$(sh.id) 1725 | Next sh 1726 | End Sub 1727 | 1728 | ' 1729 | ' This is a support function for the bakeSlideNumbers sub. What it does 1730 | ' is to move a currently selected placeholder to the slides that are set 1731 | ' to show it, and bake text that appears inside it. 1732 | ' 1733 | Private Sub bakePlaceholder(footerElement, start_index, end_index, designIndex, titleMasterExists As Boolean, isTitleMaster As Boolean) 1734 | Dim sh As Shape, currentSlide As Slide 1735 | If ActiveWindow.Selection.Type = ppSelectionShapes Then 1736 | ' Make the shape recognizeable as a placeholder before moving it 1737 | ActiveWindow.Selection.ShapeRange.Tags.Add "placeholder", Right$(Str$(footerElement), 1) 1738 | ActiveWindow.Selection.ShapeRange.Tags.Add "shapeId", "placeholder" + Right$(Str$(footerElement), 1) 1739 | ' Remove shape from the slide master (will be pasted later in the slides 1740 | ' where it is supposed to appear) 1741 | ActiveWindow.Selection.Cut 1742 | ActiveWindow.ViewType = ppViewNormal 1743 | For Each currentSlide In ActivePresentation.Slides 1744 | With currentSlide 1745 | sameDesign = (.Design.Index = designIndex) 1746 | If sameDesign Then 1747 | ' Layout can only be checked if the current slide uses the 1748 | ' design from which we took the placeholder. Otherwise, we risk 1749 | ' to seek a TitleMaster for a design that does not have it. 1750 | If titleMasterExists Then 1751 | If isTitleMaster Then 1752 | matchingLayout = (.Layout = ppLayoutTitle And .Design.TitleMaster.HeadersFooters.DisplayOnTitleSlide) 1753 | Else 1754 | matchingLayout = (.Layout <> ppLayoutTitle) 1755 | End If 1756 | Else 1757 | matchingLayout = ((.Layout = ppLayoutTitle And .Design.SlideMaster.HeadersFooters.DisplayOnTitleSlide) Or _ 1758 | (.Layout <> ppLayoutTitle)) 1759 | End If 1760 | End If 1761 | If sameDesign And matchingLayout Then 1762 | If (footerElement = 1 And .HeadersFooters.DateAndTime.Visible) Or _ 1763 | (footerElement = 2 And .HeadersFooters.Footer.Visible) Or _ 1764 | (footerElement = 3 And .HeadersFooters.SlideNumber.Visible) Then 1765 | .Shapes.Paste 1766 | For Each sh In .Shapes 1767 | If sh.Tags("placeholder") <> "" Then 1768 | sh.ZOrder msoSendToBack 1769 | ' Text is baked character by character, in order to avoid losing formatting 1770 | For c = 1 To sh.TextFrame.TextRange.Characters.Count 1771 | sh.TextFrame.TextRange.Characters(c) = sh.TextFrame.TextRange.Characters(c) 1772 | Next c 1773 | ' Shape names must be unique (a "Permission Denied" error is raised otherwise) 1774 | sh.Name = "slideNumberPlaceholder" & Str$(sh.id) 1775 | End If 1776 | Next sh 1777 | End If 1778 | End If 1779 | End With 1780 | Next currentSlide 1781 | End If 1782 | End Sub 1783 | 1784 | 1785 | ' 1786 | ' This function moves elements from slide masters to slides, in order to keep slide 1787 | ' numbers fixed during the split. Note that slide numbers may occur in several shapes 1788 | ' in a slide master, not just the "slide number" footer: slide numbers appearing in 1789 | ' such extra shapes will not be processed. 1790 | ' 1791 | Private Sub bakeSlideNumbers(start_index, end_index) 1792 | Dim shs As Shapes, d As Design, sh As Shape 1793 | 1794 | 1795 | ProgressForm.infoLabel = "Adjusting slide numbers. This may take some time..." 1796 | 1797 | ' Cycle through all slide masters, including title ones, and move relevant placeholders 1798 | ' to all the slides that use them. When moving, text is reassigned so that any special 1799 | ' field is replaced by its actual value 1800 | 1801 | For footerElement = 1 To 3 1802 | For d_index = 1 To ActivePresentation.Designs.Count 1803 | ' PowerPoint requires a specific Design to be currently displayed in order 1804 | ' to be able to select its shapes. Now, since the only way in PowerPoint 2003 1805 | ' to switch to a Design view is to use ppViewTitleMaster or ppViewSlideMaster, 1806 | ' both pointing to the first Design, here is a 1807 | ' horrible hack to always keep the Design of interest first. Interestingly, 1808 | ' reordering Designs does not have adverse effects on their usage in slides. 1809 | ActivePresentation.Designs(d_index).MoveTo 1 1810 | Set d = ActivePresentation.Designs(1) 1811 | 1812 | ProgressForm.SlideBar.value = (ActivePresentation.Designs.Count * (footerElement - 1) + d_index) / (ActivePresentation.Designs.Count * 3) * 100 1813 | ProgressForm.Repaint 1814 | ' Clear current selection (if any) 1815 | ActiveWindow.Selection.Unselect 1816 | If d.HasTitleMaster Then 1817 | ' Must switch to an appropriate view in order to be able to select shapes. 1818 | ' Note that we first switch to slide view because, in order to make sure that 1819 | ' the first available title master is selected, we must come from a different 1820 | ' view. 1821 | ActiveWindow.ViewType = ppViewSlide 1822 | ActiveWindow.ViewType = ppViewTitleMaster 1823 | For Each sh In d.TitleMaster.Shapes 1824 | If sh.Type = msoPlaceholder Then 1825 | If (footerElement = 1 And sh.PlaceholderFormat.Type = ppPlaceholderDate) Or _ 1826 | (footerElement = 2 And sh.PlaceholderFormat.Type = ppPlaceholderFooter) Or _ 1827 | (footerElement = 3 And sh.PlaceholderFormat.Type = ppPlaceholderSlideNumber) Then sh.Select msoTrue 1828 | End If 1829 | Next sh 1830 | bakePlaceholder footerElement, start_index, end_index, d.Index, True, True 1831 | End If 1832 | ' Must switch to an appropriate view in order to be able to select shapes. 1833 | ' Note that we first switch to slide view because, in order to make sure that 1834 | ' the first available slide master is selected, we must come from a different 1835 | ' view. 1836 | ActiveWindow.ViewType = ppViewSlide 1837 | ActiveWindow.ViewType = ppViewSlideMaster 1838 | For Each sh In d.SlideMaster.Shapes 1839 | If sh.Type = msoPlaceholder Then 1840 | If (footerElement = 1 And sh.PlaceholderFormat.Type = ppPlaceholderDate) Or _ 1841 | (footerElement = 2 And sh.PlaceholderFormat.Type = ppPlaceholderFooter) Or _ 1842 | (footerElement = 3 And sh.PlaceholderFormat.Type = ppPlaceholderSlideNumber) Then sh.Select msoTrue 1843 | End If 1844 | Next sh 1845 | bakePlaceholder footerElement, start_index, end_index, d.Index, d.HasTitleMaster, False 1846 | Next d_index 1847 | Next footerElement 1848 | 1849 | ActiveWindow.ViewType = ppViewNormal 1850 | 1851 | End Sub 1852 | 1853 | ' 1854 | ' This function enriches existing slide numbers with a subindex, namely a progressive 1855 | ' number assigned anew to each slide resulting from splitting a single original one. 1856 | ' It works in close conjunction with bakeSlideNumbers, with a main difference: 1857 | ' - bakeSlideNumbers is invoked once on all the slide deck to make slide numbers 1858 | ' persistent 1859 | ' - augmentSlideNumbers is invoked once for each split slide, strictly after processing 1860 | ' of that slide has finished and, possibly, after a duplicate of that slide is 1861 | ' generated (modified slide numbers would otherwise be inherited in all subsequent 1862 | ' slides) 1863 | ' 1864 | Private Sub augmentSlideNumbers(slide_number, progressive_slide_count) 1865 | Dim sh As Shape 1866 | 1867 | For Each sh In ActivePresentation.Slides(slide_number).Shapes 1868 | If slideNumbersAdjustMode = SLIDENUMBER_SUBINDEX And Left$(sh.Name, 22) = "slideNumberPlaceholder" Then 1869 | sh.TextFrame.TextRange.InsertAfter "." + Right$(Str$(progressive_slide_count), Len(Str$(progressive_slide_count)) - 1) 1870 | End If 1871 | Next sh 1872 | End Sub 1873 | 1874 | Sub PPspliT_main() 1875 | On Error GoTo error_handler 1876 | 1877 | If Application.Presentations.Count = 0 Then 1878 | Exit Sub 1879 | End If 1880 | 1881 | Dim slide_timeline As Sequence 1882 | cancelStatus = False 1883 | 1884 | ' Non-contiguous ranges of slides are NOT supported: they are assumed to 1885 | ' start at the lowest numbered selected slide and end at the highest numbered 1886 | ' selected slide. 1887 | If ActiveWindow.Selection.Type = ppSelectionSlides Then 1888 | min_slide_index = 32767 1889 | max_slide_index = 0 1890 | For Each s In ActiveWindow.Selection.SlideRange 1891 | If s.SlideIndex < min_slide_index Then min_slide_index = s.SlideIndex 1892 | If s.SlideIndex > max_slide_index Then max_slide_index = s.SlideIndex 1893 | Next s 1894 | slide_number = min_slide_index 1895 | tot_slides = max_slide_index 1896 | split_selected_slides = MsgBox(prompt:="It seems that a set of slides is currently selected. " + _ 1897 | "By proceeding, you will only be splitting slides in the range" + Str$(min_slide_index) + "-" + Right$(Str$(max_slide_index), Len(Str$(max_slide_index)) - 1) + "." + Chr$(13) + _ 1898 | "(non-contiguous sets of slides are not supported, therefore all the slides between the first and last selected ones will be affected by the split process)." + Chr$(13) + _ 1899 | "Click " + Chr$(34) + "Yes" + Chr$(34) + " if this is what you want." + Chr$(13) + _ 1900 | "Click " + Chr$(34) + "No" + Chr$(34) + " if you want to split ALL the slides in the presentation instead." + Chr$(13) + _ 1901 | "Click " + Chr$(34) + "Cancel" + Chr$(34) + " to simply cancel the operation.", buttons:=vbYesNoCancel, Title:="PPspliT - Information request") 1902 | If split_selected_slides = vbNo Then 1903 | slide_number = 1 1904 | tot_slides = ActivePresentation.Slides.Count 1905 | ElseIf split_selected_slides = vbCancel Then 1906 | Exit Sub 1907 | End If 1908 | Else 1909 | slide_number = 1 1910 | tot_slides = ActivePresentation.Slides.Count 1911 | End If 1912 | 1913 | ProgressForm.SlideBar.value = 0 1914 | ProgressForm.OverallBar.value = 0 1915 | ProgressForm.Show 1916 | 1917 | If ActiveWindow.ViewType <> ppViewSlide And ActiveWindow.ViewType <> ppViewNormal Then 1918 | ActiveWindow.ViewType = ppViewNormal 1919 | End If 1920 | 1921 | ' Bake slide numbers (and other footers that may contain slide numbers) into the 1922 | ' presentation, if requested. 1923 | If slideNumbersAdjustMode <> SLIDENUMBER_DONOTHING Then bakeSlideNumbers slide_number, tot_slides 1924 | 1925 | ' Since lots of duplicate slides will be created in the process, I must 1926 | ' keep note of: 1927 | ' orig_tot_slides, which is the total number of slides in the selected 1928 | ' range before creating duplicate slides 1929 | orig_tot_slides = tot_slides 1930 | ' actual_slide, which is the number of slides in the originally selected range 1931 | ' that have been processed until now 1932 | actual_slide = slide_number 1933 | ' 1934 | ' Iterate over all the slides in the presentation 1935 | ' 1936 | While actual_slide <= tot_slides 1937 | additional_slide_present = False 1938 | ProgressForm.SlideNumber = "Slide " + Str$(actual_slide) + " of " + Str$(orig_tot_slides) 1939 | alreadyPurged = False 1940 | ' Count of slides generated from splitting a single original one 1941 | split_slides = 0 1942 | If ActivePresentation.Slides(slide_number).TimeLine.MainSequence.Count > 0 Then 1943 | ' 1944 | ' There are effects to be processed in the current slide 1945 | ' 1946 | 1947 | copyShapeIds ActivePresentation.Slides(slide_number) 1948 | 1949 | ' 1950 | ' First of all, take care of effects that start without a click 1951 | ' (and, therefore, have an immediate effect on the rendered slide) 1952 | ' 1953 | cont = (ActivePresentation.Slides(slide_number).TimeLine.MainSequence(1).Timing.TriggerType = msoAnimTriggerWithPrevious _ 1954 | Or ActivePresentation.Slides(slide_number).TimeLine.MainSequence(1).Timing.TriggerType = msoAnimTriggerAfterPrevious) 1955 | If cont And Not doNotSplitMouseTriggered Then 1956 | ' Keep a copy of the original slide, which I will use to track the animation 1957 | ' sequence. I always proceed in this way: I carry the original slide 1958 | ' unaltered and grab the list of effects to be applied from it, while 1959 | ' shapes are actually modified on copies of that original slide 1960 | ActivePresentation.Slides(slide_number).Duplicate 1961 | ' Remember to remove the duplicated slide later on 1962 | additional_slide_present = True 1963 | Set slide_timeline = ActivePresentation.Slides(slide_number + 1).TimeLine.MainSequence 1964 | ' Remove all the shapes that will appear after a future entry effect 1965 | purgeFutureShapes ActivePresentation.Slides(slide_number), False 1966 | purgeEffects ActivePresentation.Slides(slide_number) 1967 | alreadyPurged = True 1968 | End If 1969 | While cont And Not doNotSplitMouseTriggered 1970 | ' Actually, there are animations that start without a click 1971 | applyEffect ActivePresentation.Slides(slide_number), ActivePresentation.Slides(slide_number + 1) 1972 | ' Some effects have disappeared: check whether I still have 1973 | ' effects that start without a click 1974 | If slide_timeline.Count = 0 Then 1975 | cont = False 1976 | Else 1977 | ' Go on until I encounter a mouse-triggered effect 1978 | cont = (slide_timeline(1).Timing.TriggerType = msoAnimTriggerWithPrevious _ 1979 | Or slide_timeline(1).Timing.TriggerType = msoAnimTriggerAfterPrevious) 1980 | End If 1981 | Wend 1982 | If additional_slide_present Then 1983 | ' Match the Z order of shapes between the original slide and its 1984 | ' duplicate. 1985 | matchZOrder ActivePresentation.Slides(slide_number), ActivePresentation.Slides(slide_number + 1) 1986 | End If 1987 | Else 1988 | actual_slide = actual_slide + 1 1989 | End If 1990 | 1991 | ' 1992 | ' Now, take care of mouse-triggered effects 1993 | ' 1994 | ' Get the number of animation effects from the correct slide. 1995 | If additional_slide_present Then 1996 | tot_anims = ActivePresentation.Slides(slide_number + 1).TimeLine.MainSequence.Count 1997 | Else 1998 | tot_anims = ActivePresentation.Slides(slide_number).TimeLine.MainSequence.Count 1999 | End If 2000 | If tot_anims > 0 Then 2001 | processed_anims = 0 2002 | If Not alreadyPurged Then 2003 | ActivePresentation.Slides(slide_number).Duplicate 2004 | purgeFutureShapes ActivePresentation.Slides(slide_number), False 2005 | purgeEffects ActivePresentation.Slides(slide_number) 2006 | alreadyPurged = True 2007 | 2008 | End If 2009 | ActivePresentation.Slides(slide_number).Duplicate 2010 | split_slides = split_slides + 1 2011 | augmentSlideNumbers slide_number, split_slides 2012 | slide_number = slide_number + 1 2013 | While ActivePresentation.Slides(slide_number + 1).TimeLine.MainSequence.Count > 0 2014 | ' Mouse-triggered effects need to be split on two different slides 2015 | ' Now iterate over all non-mouse-triggered effects starting with the current one 2016 | cont = True 2017 | While cont 2018 | ' The applyEffect method eats an animation effect for each call, 2019 | ' unless it returns 1. 2020 | addedEffects = applyEffect(ActivePresentation.Slides(slide_number), ActivePresentation.Slides(slide_number + 1)) 2021 | 2022 | ' 2023 | ' Ok, the current effect has been processed. Keep staying on the same slide 2024 | ' as long as there are other non-mouse-triggered effects. 2025 | ' 2026 | Set slide_timeline = ActivePresentation.Slides(slide_number + 1).TimeLine.MainSequence 2027 | If slide_timeline.Count = 0 Then 2028 | ' No more effects to process (this must be checked on the next slide, 2029 | ' as several effects and shapes may have been removed in the current 2030 | ' one) 2031 | cont = False 2032 | Else 2033 | cont = (slide_timeline(1).Timing.TriggerType = msoAnimTriggerWithPrevious _ 2034 | Or slide_timeline(1).Timing.TriggerType = msoAnimTriggerAfterPrevious) And Not doNotSplitMouseTriggered 2035 | End If 2036 | processed_anims = processed_anims + 1 - addedEffects 2037 | anims_percentage = Int(processed_anims / tot_anims * 100) 2038 | 2039 | ProgressForm.SlideLabel = Str$(anims_percentage) + " %" 2040 | ProgressForm.SlideBar.value = anims_percentage 2041 | ProgressForm.Repaint 2042 | DoEvents 2043 | If cancelStatus Then 2044 | Unload ProgressForm 2045 | Exit Sub 2046 | End If 2047 | Wend 2048 | matchZOrder ActivePresentation.Slides(slide_number), ActivePresentation.Slides(slide_number + 1) 2049 | If slide_timeline.Count > 0 Then 2050 | ActivePresentation.Slides(slide_number).Duplicate 2051 | split_slides = split_slides + 1 2052 | augmentSlideNumbers slide_number, split_slides ' Try (hard) to trigger text auto-fit in PowerPoint <= 2003 2053 | For Each shape_object In ActivePresentation.Slides(slide_number + 1).Shapes 2054 | shape_object.Height = shape_object.Height + 0.01 2055 | shape_object.Height = shape_object.Height - 0.01 2056 | Next shape_object 2057 | purgeEffects ActivePresentation.Slides(slide_number) 2058 | slide_number = slide_number + 1 2059 | Else 2060 | ' No more animations to process, but the last slide might still need some 2061 | ' touching of slide numbers 2062 | split_slides = split_slides + 1 2063 | augmentSlideNumbers slide_number, split_slides 2064 | End If 2065 | Wend 2066 | ActivePresentation.Slides(slide_number + 1).Delete 2067 | additional_slide_present = False 2068 | ' All the animations for the current slide have been processed 2069 | purgeEffects ActivePresentation.Slides(slide_number) 2070 | actual_slide = actual_slide + 1 2071 | End If ' tot_anims > 0 2072 | If additional_slide_present Then 2073 | ActivePresentation.Slides(slide_number + 1).Delete 2074 | purgeEffects ActivePresentation.Slides(slide_number) 2075 | actual_slide = actual_slide + 1 2076 | End If 2077 | 2078 | slide_number = slide_number + 1 2079 | 2080 | overall_percentage = Int((actual_slide - 1) / orig_tot_slides * 100) 2081 | ProgressForm.OverallLabel = Str$(overall_percentage) + " %" 2082 | ProgressForm.OverallBar = overall_percentage 2083 | ProgressForm.SlideLabel = "" 2084 | ProgressForm.SlideBar = 0 2085 | ProgressForm.Repaint 2086 | DoEvents 2087 | If cancelStatus Then 2088 | Unload ProgressForm 2089 | Exit Sub 2090 | End If 2091 | Wend ' actual_slide <= tot_slides 2092 | 2093 | Unload ProgressForm 2094 | Exit Sub 2095 | 2096 | error_handler: 2097 | resp = MsgBox("Sorry, but despite the efforts in foreseeing and catching possible anomalies, I have incurred an unrecoverable error." & vbCrLf & _ 2098 | "Error number: " & Str$(Err.Number) & vbCrLf & _ 2099 | "Error description: " & Err.Description & vbCrLf & _ 2100 | "Slide number: " & slide_number & vbCrLf & "Would you like to try continuing anyway (discouraged)?", vbYesNo, "Fatal error") 2101 | If resp = vbYes Then 2102 | Resume Next 2103 | Else 2104 | On Error GoTo 0 2105 | Resume 2106 | End If 2107 | End Sub 2108 | 2109 | ' The status of the "Slide numbers" dropdown 2110 | ' has been changed 2111 | Sub changeAdjustSlideNumbersStatus() 2112 | Dim myBar As CommandBar, myDropdown As CommandBarComboBox 2113 | For Each b In CommandBars 2114 | If b.Name = "PPspliT" Then 2115 | Set myBar = b 2116 | End If 2117 | Next b 2118 | Set myDropdown = myBar.Controls(4) 2119 | slideNumbersAdjustMode = myDropdown.ListIndex 2120 | End Sub 2121 | 2122 | ' The status of the "split on mouse-triggered animations" button 2123 | ' has been changed 2124 | Sub changeMouseSplitStatus() 2125 | Dim myBar As CommandBar, myButton As CommandBarButton 2126 | For Each b In CommandBars 2127 | If b.Name = "PPspliT" Then 2128 | Set myBar = b 2129 | End If 2130 | Next b 2131 | Set myButton = myBar.Controls(2) 2132 | If myButton.State = msoButtonDown Then 2133 | myButton.State = msoButtonUp 2134 | Else 2135 | myButton.State = msoButtonDown 2136 | End If 2137 | doNotSplitMouseTriggered = (myButton.State = msoButtonUp) 2138 | End Sub 2139 | 2140 | ' Add the PPspliT toolbar, if not present 2141 | Sub auto_open() 2142 | Dim a As AddIn 2143 | For Each a In AddIns 2144 | If a.Name = "PPspliT" Then 2145 | aPath = a.Path 2146 | End If 2147 | Next a 2148 | slideNumbersAdjustMode = SLIDENUMBER_BAKE 2149 | splitMouseTriggered = False 2150 | 2151 | ' Any possibly existing command bar is replaced, to allow add-in 2152 | ' upgrades that change its structure 2153 | For Each b In CommandBars 2154 | If b.Name = "PPspliT" Then b.Delete 2155 | Next b 2156 | 2157 | ' (Re-)create the command bar 2158 | Dim newBar As CommandBar, newButton As CommandBarButton, newDropdown As CommandBarComboBox 2159 | Set newBar = CommandBars.Add(Name:="PPspliT", Position:=msoBarTop, temporary:=True) 2160 | 2161 | Set newButton = newBar.Controls.Add(msoControlButton) 2162 | newButton.OnAction = "PPspliT_main" 2163 | newButton.TooltipText = "Split animations" 2164 | newButton.Caption = "Split animations" 2165 | newButton.Style = msoButtonIconAndCaption 2166 | If aPath <> "" Then 2167 | newButton.Picture = LoadPicture(aPath + "\ppsplit-button.gif") 2168 | End If 2169 | 2170 | Set newButton = newBar.Controls.Add(msoControlButton) 2171 | newButton.OnAction = "changeMouseSplitStatus" 2172 | newButton.TooltipText = "Split on click-triggered animation effects" 2173 | newButton.Caption = "Split on click-triggered effects" 2174 | If aPath <> "" Then 2175 | newButton.Picture = LoadPicture(aPath + "\mouse-button.gif") 2176 | End If 2177 | newButton.State = msoButtonDown 2178 | newButton.BeginGroup = True 2179 | 2180 | Set newButton = newBar.Controls.Add(msoControlButton) 2181 | newButton.TooltipText = "How to handle slide numbers in slide footers" 2182 | newButton.Caption = "Slide numbers:" 2183 | newButton.Style = msoButtonCaption 2184 | newButton.Enabled = False 2185 | newButton.BeginGroup = True 2186 | 2187 | Set newDropdown = newBar.Controls.Add(msoControlDropdown) 2188 | newDropdown.AddItem "Do nothing", 1 2189 | newDropdown.AddItem "Preserve original", 2 2190 | newDropdown.AddItem "Preserve, and add subindex", 3 2191 | newDropdown.OnAction = "changeAdjustSlideNumbersStatus" 2192 | newDropdown.TooltipText = "How to handle slide numbers in slide footers" 2193 | newDropdown.Caption = "Slide number adjustment setting" 2194 | newDropdown.Width = 160 2195 | newDropdown.ListIndex = SLIDENUMBER_BAKE 2196 | 2197 | Set newButton = newBar.Controls.Add(msoControlButton) 2198 | newButton.OnAction = "displayAboutForm" 2199 | newButton.TooltipText = "About" 2200 | newButton.Caption = "About" 2201 | newButton.Style = msoButtonIconAndCaption 2202 | If aPath <> "" Then 2203 | newButton.Picture = LoadPicture(aPath + "\about-button.gif") 2204 | End If 2205 | newButton.BeginGroup = True 2206 | 2207 | newBar.Visible = True 2208 | End Sub 2209 | 2210 | ' Remove the PPspliT toolbar, if existing 2211 | Sub auto_close() 2212 | Dim myBar As CommandBar 2213 | foundBar = False 2214 | For Each b In CommandBars 2215 | If b.Name = "PPspliT" Then 2216 | foundBar = True 2217 | Set myBar = b 2218 | End If 2219 | Next b 2220 | If foundBar Then 2221 | myBar.Delete 2222 | End If 2223 | End Sub 2224 | 2225 | ' Display the about form 2226 | Sub displayAboutForm() 2227 | AboutForm.Show 2228 | End Sub 2229 | -------------------------------------------------------------------------------- /src/PPT11-/PPspliT.ppa: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/src/PPT11-/PPspliT.ppa -------------------------------------------------------------------------------- /src/PPT11-/PPspliT.ppt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/src/PPT11-/PPspliT.ppt -------------------------------------------------------------------------------- /src/PPT12+/AboutForm.frm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/src/PPT12+/AboutForm.frm -------------------------------------------------------------------------------- /src/PPT12+/AboutForm.frx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/src/PPT12+/AboutForm.frx -------------------------------------------------------------------------------- /src/PPT12+/PPspliT.ppam: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/src/PPT12+/PPspliT.ppam -------------------------------------------------------------------------------- /src/PPT12+/PPspliT.pptm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/src/PPT12+/PPspliT.pptm -------------------------------------------------------------------------------- /src/PPT12+/ProgressForm.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} ProgressForm 3 | Caption = "PPspliT progress" 4 | ClientHeight = 2430 5 | ClientLeft = 30 6 | ClientTop = 330 7 | ClientWidth = 7260 8 | OleObjectBlob = "ProgressForm.frx":0000 9 | ShowModal = 0 'False 10 | StartUpPosition = 1 'CenterOwner 11 | End 12 | Attribute VB_Name = "ProgressForm" 13 | Attribute VB_GlobalNameSpace = False 14 | Attribute VB_Creatable = False 15 | Attribute VB_PredeclaredId = True 16 | Attribute VB_Exposed = False 17 | Private Sub CancelButton_Click() 18 | If MsgBox("Are you sure you want to cancel the operation?", vbYesNo, "PPspliT question") = vbYes Then 19 | PPspliT.cancelStatus = True 20 | End If 21 | End Sub 22 | -------------------------------------------------------------------------------- /src/PPT12+/ProgressForm.frx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/src/PPT12+/ProgressForm.frx -------------------------------------------------------------------------------- /src/common_resources/about-button.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/src/common_resources/about-button.gif -------------------------------------------------------------------------------- /src/common_resources/about.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/src/common_resources/about.png -------------------------------------------------------------------------------- /src/common_resources/mouse-button.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/src/common_resources/mouse-button.gif -------------------------------------------------------------------------------- /src/common_resources/ppsplit-button.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/src/common_resources/ppsplit-button.gif -------------------------------------------------------------------------------- /src/common_resources/ppsplit-large.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/src/common_resources/ppsplit-large.bmp -------------------------------------------------------------------------------- /src/common_resources/ppsplit-large.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/src/common_resources/ppsplit-large.png -------------------------------------------------------------------------------- /src/common_resources/ppsplit-small.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/src/common_resources/ppsplit-small.png -------------------------------------------------------------------------------- /src/common_resources/ppsplit-uninst-large.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/src/common_resources/ppsplit-uninst-large.bmp -------------------------------------------------------------------------------- /src/common_resources/ppsplit-wide.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/src/common_resources/ppsplit-wide.bmp -------------------------------------------------------------------------------- /src/common_resources/ppsplit.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/src/common_resources/ppsplit.ico -------------------------------------------------------------------------------- /src/common_resources/ppsplit.xcf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/src/common_resources/ppsplit.xcf -------------------------------------------------------------------------------- /src/common_resources/slide-numbers.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maxonthegit/PPspliT/3340c48574d16634d1419861380f74f0f3388758/src/common_resources/slide-numbers.gif -------------------------------------------------------------------------------- /src/license.txt: -------------------------------------------------------------------------------- 1 | This package contains a PowerPoint add-in that splits animation effects into different slides. 2 | 3 | The add-in is the result of the entertaining time of a VBA enthusiast, not a professional developer. Although I perform several tests before releasing new versions and use the add-in myself, I cannot give warranties of any kind that it will operate as expected and will not cause damage to your presentations or even to your system. 4 | I'm not saying this to frighten you, but rather to reassure me :-) 5 | 6 | You are free to use this add-in in whatever context you like to, and redistribution is also encouraged. 7 | If you like, drop me a line so that I can collect some feedback on its usage: I am very happy to be acquainted with your experiences. And, yes, should you need help you can try to ask me of course: I always do my best to answer your requests but, honestly, I do not have enough resources (time, typically) to provide you with a real "technical support". 8 | 9 | https://www.maxonthenet.altervista.org/ 10 | 11 | Many of the feedbacks I have already received are (fortunately) positive. Somebody even felt so grateful that he sought for more effective ways of expressing his gratitude. I repeat: a message from yours is more than enough. 12 | But, if you really eager for a more concrete way of saying "thank you" and are happy with the awareness that this will not push development nor grant you any additional technical support, well... here is my Paypal account for sending a donation: 13 | 14 | maxonthenet@tiscali.it 15 | 16 | A doubled thank you to those who will choose to go this way! 17 | -------------------------------------------------------------------------------- /src/ppsplit_installer.nsi: -------------------------------------------------------------------------------- 1 | ; NullSoft installer script for PPspliT 2 | ; Written by Massimo Rimondini 3 | 4 | ;-------------------------------- 5 | 6 | ; Use modern user interface 7 | !include "MUI2.nsh" 8 | ; Support easier-to-write conditional expressions 9 | !include LogicLib.nsh 10 | 11 | 12 | ; Define some variables 13 | Var HOST_ARCH 14 | Var PPSPLIT_RELEASE 15 | Var REGISTRATION_HANDLER 16 | Var CURRENT_OFFICE_RELEASE 17 | Var SHORT_OFFICE_RELEASE 18 | Var RELEASE_ARCH 19 | Var CURRENT_OFFICE_REGKEY 20 | Var ADDIN_FILE 21 | 22 | Var ERRORS ; if "yes" at the end of the install, then errors have occurred in setting up the add-in 23 | Var CONFIGURED ; if "" at the end of the install, then the add-in has not been set up for any Office releases 24 | 25 | ;-------------------------------- 26 | 27 | ; This function must be shared between installer and uninstaller 28 | !macro define_init_callback un 29 | Function ${un}.onInit 30 | StrCpy $PPSPLIT_RELEASE "2.6" 31 | StrCpy $ERRORS "" 32 | StrCpy $CONFIGURED "" 33 | ReadRegStr $HOST_ARCH HKLM "System\CurrentControlSet\Control\Session Manager\Environment" "PROCESSOR_ARCHITECTURE" 34 | FunctionEnd 35 | !macroend 36 | !insertmacro define_init_callback "" 37 | !insertmacro define_init_callback "un" 38 | 39 | ;-------------------------------- 40 | 41 | ; Installer package attributes 42 | Name "PPspliT" 43 | !define MUI_ICON common_resources\ppsplit.ico 44 | !define MUI_UNICON common_resources\ppsplit.ico 45 | OutFile "..\PPspliT-setup.exe" 46 | 47 | ; User interface options 48 | BrandingText "PPspliT $PPSPLIT_RELEASE installer" 49 | !define MUI_HEADERIMAGE 50 | !define MUI_HEADERIMAGE_BITMAP "common_resources\ppsplit-wide.bmp" 51 | !define MUI_WELCOMEFINISHPAGE_BITMAP "common_resources\ppsplit-large.bmp" 52 | !define MUI_WELCOMEFINISHPAGE_BITMAP_NOSTRETCH 53 | !define MUI_PAGE_HEADER_TEXT "PPspliT version $PPSPLIT_RELEASE" 54 | !define MUI_PAGE_HEADER_SUBTEXT "Setup procedure" 55 | ; Ask for confirmation on abort request from the user 56 | !define MUI_ABORTWARNING 57 | !define MUI_ABORTWARNING_CANCEL_DEFAULT 58 | 59 | ; Give the user some time to read the installation log 60 | !define MUI_FINISHPAGE_NOAUTOCLOSE 61 | 62 | ; Request application privileges for Windows Vista 63 | RequestExecutionLevel user 64 | 65 | ;-------------------------------- 66 | 67 | !define MUI_WELCOMEPAGE_TITLE "PPspliT setup" 68 | !define MUI_WELCOMEPAGE_TEXT "Welcome to the PPspliT installer!$\n$\nThis tool will guide you to the easy process of setting up PPspliT on your computer.$\n$\nPlease make sure that PowerPoint is not running before proceeding." 69 | 70 | !insertmacro MUI_PAGE_WELCOME 71 | 72 | ;-------------------------------- 73 | 74 | !define MUI_LICENSEPAGE_TEXT_TOP "Please review the following licensing and usage information:" 75 | !define MUI_LICENSEPAGE_TEXT_BOTTOM "After you have read the above conditions, check the box below to continue." 76 | !define MUI_LICENSEPAGE_CHECKBOX 77 | !define MUI_LICENSEPAGE_CHECKBOX_TEXT "I have read the licensing and usage information." 78 | 79 | !insertmacro MUI_PAGE_LICENSE license.txt 80 | 81 | ;-------------------------------- 82 | 83 | InstallDir $APPDATA\Microsoft\AddIns\PPspliT 84 | 85 | !insertmacro MUI_PAGE_INSTFILES 86 | 87 | ;-------------------------------- 88 | 89 | !define MUI_FINISHPAGE_TEXT "Setup of PPspliT is now complete!$\n$\nTo start using the add-in, simply start PowerPoint and look for the PPspliT toolbar.$\n$\n$\nIf you want to remove the add-in, use the $\"Add/Remove Programs$\" tool in the Control Panel." 90 | 91 | !insertmacro MUI_PAGE_FINISH 92 | 93 | ;-------------------------------- 94 | 95 | ; Uninstaller attributes 96 | !define MUI_UNABORTWARNING 97 | 98 | !define MUI_UNWELCOMEFINISHPAGE_BITMAP "common_resources\ppsplit-uninst-large.bmp" 99 | !define MUI_UNWELCOMEFINISHPAGE_BITMAP_NOSTRETCH 100 | !insertmacro MUI_UNPAGE_WELCOME 101 | 102 | !insertmacro MUI_UNPAGE_CONFIRM 103 | 104 | !insertmacro MUI_UNPAGE_INSTFILES 105 | 106 | !define MUI_UNFINISHPAGE_NOAUTOCLOSE 107 | !insertmacro MUI_UNPAGE_FINISH 108 | 109 | ;-------------------------------- 110 | 111 | ; This function must be shared between installer and uninstaller 112 | !macro define_addin_registration_function un 113 | Function ${un}Handle_Addin_Registration 114 | Push $0 ; Index of the currently processed registry key 115 | Push $1 ; Descriptive Office release (for logging) 116 | Push $2 ; Temp variable to store PowerPoint installation path (never really used except to verify actual installation) 117 | Push $3 ; 0 when looking in the 32-bit registry view; 1 when looking in the 64-bit view 118 | StrCpy $0 0 ; Iterates over registry keys representing candidate Office releases 119 | SetRegView 32 120 | ${un}Loop: 121 | ; Enumerate all Office releases found in the registry 122 | EnumRegKey $CURRENT_OFFICE_RELEASE HKLM "Software\Microsoft\Office" $0 123 | StrCmp "" $CURRENT_OFFICE_RELEASE ${un}Done 124 | 125 | ; We now check that the currently found Office release is really installed 126 | StrCpy $RELEASE_ARCH "" 127 | StrCpy $CURRENT_OFFICE_REGKEY "Software\Microsoft\Office\$CURRENT_OFFICE_RELEASE" 128 | ReadRegStr $2 HKLM "$CURRENT_OFFICE_REGKEY\PowerPoint\InstallRoot" "Path" 129 | IfErrors ${un}Next 130 | 131 | 132 | ; We are now sure that the current Office release is really installed 133 | 134 | ; Only the first 2 characters of the Office release are relevant 135 | StrCpy $SHORT_OFFICE_RELEASE $CURRENT_OFFICE_RELEASE 2 136 | StrCpy $1 "unknown release" 137 | ; Assume we could not recognize the Office release until we actually do 138 | StrCpy $ERRORS "yes" 139 | StrCmp "10" $SHORT_OFFICE_RELEASE 0 +3 140 | StrCpy $1 "Office XP" 141 | StrCpy $ERRORS "" 142 | StrCmp "11" $SHORT_OFFICE_RELEASE 0 +3 143 | StrCpy $1 "Office 2003" 144 | StrCpy $ERRORS "" 145 | StrCmp "12" $SHORT_OFFICE_RELEASE 0 +3 146 | StrCpy $1 "Office 2007" 147 | StrCpy $ERRORS "" 148 | StrCmp "14" $SHORT_OFFICE_RELEASE 0 +3 149 | StrCpy $1 "Office 2010" 150 | StrCpy $ERRORS "" 151 | StrCmp "15" $SHORT_OFFICE_RELEASE 0 +3 152 | StrCpy $1 "Office 2013" 153 | StrCpy $ERRORS "" 154 | StrCmp "16" $SHORT_OFFICE_RELEASE 0 +3 155 | StrCpy $1 "Office 2016/2019/2021" 156 | StrCpy $ERRORS "" 157 | 158 | ${If} $3 = 0 159 | ; First iteration: 32-bit 160 | StrCpy $RELEASE_ARCH "x86" 161 | ${Else} 162 | ; Second iteration: 64-bit 163 | StrCpy $RELEASE_ARCH "amd64" 164 | ${EndIf} 165 | 166 | DetailPrint " Configuring PowerPoint $CURRENT_OFFICE_RELEASE ($1), architecture $RELEASE_ARCH" 167 | StrCpy $CONFIGURED "yes" 168 | 169 | ; Warning section 170 | ${If} $SHORT_OFFICE_RELEASE == 15 171 | ${OrIf} $SHORT_OFFICE_RELEASE == 16 172 | ${EndIf} 173 | 174 | ; Determine the correct version of the add-in to install 175 | ${If} $SHORT_OFFICE_RELEASE <= 11 176 | ; Prior to Office 2007 177 | StrCpy $ADDIN_FILE "$INSTDIR\PPspliT.ppa" 178 | ${Else} 179 | ; Office 2007 or newer 180 | ${If} $RELEASE_ARCH == "x86" 181 | StrCpy $ADDIN_FILE "$INSTDIR\PPspliT.ppam" 182 | ${Else} 183 | StrCpy $ADDIN_FILE "$INSTDIR\PPspliT.ppam" 184 | ${EndIf} 185 | ${EndIf} 186 | Call $REGISTRATION_HANDLER 187 | ${un}Next: 188 | IntOp $0 $0 + 1 189 | Goto ${un}Loop 190 | ${un}Done: 191 | ${If} $3 = 0 192 | ${AndIf} $HOST_ARCH != "x86" 193 | ; Reiterate on 64-bit releases 194 | StrCpy $3 1 195 | StrCpy $0 0 196 | SetRegView 64 197 | Goto ${un}Loop 198 | ${EndIf} 199 | Pop $3 200 | Pop $2 201 | Pop $1 202 | Pop $0 203 | FunctionEnd 204 | !macroend 205 | !insertmacro define_addin_registration_function "" 206 | !insertmacro define_addin_registration_function "un." 207 | 208 | ;-------------------------------- 209 | 210 | Function RegisterAddin 211 | WriteRegStr HKCU "Software\Microsoft\Office\$CURRENT_OFFICE_RELEASE\PowerPoint\AddIns\PPspliT" "Path" $ADDIN_FILE 212 | WriteRegDWORD HKCU "Software\Microsoft\Office\$CURRENT_OFFICE_RELEASE\PowerPoint\AddIns\PPspliT" "AutoLoad" 1 213 | DetailPrint " Add-in registered" 214 | FunctionEnd 215 | 216 | ;-------------------------------- 217 | 218 | Function un.UnregisterAddin 219 | EnumRegKey $9 HKCU "Software\Microsoft\Office\$CURRENT_OFFICE_RELEASE\PowerPoint\AddIns\PPspliT" 0 220 | IfErrors +3 221 | DeleteRegKey HKCU "Software\Microsoft\Office\$CURRENT_OFFICE_RELEASE\PowerPoint\AddIns\PPspliT" 222 | DetailPrint " Add-in unregistered" 223 | FunctionEnd 224 | 225 | ;-------------------------------- 226 | 227 | Section "" 228 | 229 | SetDetailsView show 230 | 231 | SetOutPath $INSTDIR 232 | 233 | IfFileExists $INSTDIR\mouse-button.gif 0 +2 234 | DetailPrint "Upgrading existing installation." 235 | 236 | File ..\CHANGES.txt 237 | File common_resources\about-button.gif 238 | File common_resources\mouse-button.gif 239 | File common_resources\slide-numbers.gif 240 | File common_resources\ppsplit-button.gif 241 | File common_resources\ppsplit.ico 242 | File PPT11-\*.* 243 | File PPT12+\*.* 244 | 245 | DetailPrint "Registering add-in for all installed PowerPoint releases..." 246 | 247 | GetFunctionAddress $REGISTRATION_HANDLER RegisterAddin 248 | Call Handle_Addin_Registration 249 | 250 | WriteUninstaller "$INSTDIR\ppsplit-uninstall.exe" 251 | 252 | ; Create an entry under "Add/Remove Programs" 253 | WriteRegStr HKCU "Software\Microsoft\Windows\CurrentVersion\Uninstall\PPspliT" "DisplayName" "PPspliT" 254 | WriteRegStr HKCU "Software\Microsoft\Windows\CurrentVersion\Uninstall\PPspliT" "UninstallString" "$INSTDIR\ppsplit-uninstall.exe" 255 | WriteRegStr HKCU "Software\Microsoft\Windows\CurrentVersion\Uninstall\PPspliT" "DisplayIcon" "$INSTDIR\ppsplit.ico" 256 | WriteRegStr HKCU "Software\Microsoft\Windows\CurrentVersion\Uninstall\PPspliT" "DisplayVersion" "$PPSPLIT_RELEASE" 257 | WriteRegDWORD HKCU "Software\Microsoft\Windows\CurrentVersion\Uninstall\PPspliT" "NoModify" 1 258 | WriteRegDWORD HKCU "Software\Microsoft\Windows\CurrentVersion\Uninstall\PPspliT" "NoRepair" 1 259 | 260 | StrCmp $ERRORS "" +2 261 | MessageBox MB_OK|MB_ICONEXCLAMATION "Failed to detect any supported Office releases: the add-in may have been left unconfigured." 262 | 263 | StrCmp $CONFIGURED "" 0 +2 264 | MessageBox MB_OK|MB_ICONEXCLAMATION "Failed to automatically detect any Office releases. The add-in has been left unconfigured." 265 | SectionEnd 266 | 267 | 268 | Section "Uninstall" 269 | 270 | SetDetailsView show 271 | 272 | DetailPrint "Unregistering add-in for all installed PowerPoint releases..." 273 | 274 | GetFunctionAddress $REGISTRATION_HANDLER un.UnregisterAddin 275 | Call un.Handle_Addin_Registration 276 | 277 | ; WARNING: The following command should only be used if the InstallDir 278 | ; cannot be changed by the user (like it is the case here). Otherwise, you 279 | ; risk to wipe out important folders!! 280 | RMDir /r "$INSTDIR" 281 | 282 | DeleteRegKey HKCU "Software\Microsoft\Windows\CurrentVersion\Uninstall\PPspliT" 283 | 284 | SectionEnd 285 | 286 | !insertmacro MUI_LANGUAGE "English" 287 | LangString MUI_UNTEXT_WELCOME_INFO_TEXT ${LANG_ENGLISH} "This wizard will guide you through the uninstallation of $(^NameDA).$\r$\n$\r$\nBefore starting the uninstallation, make sure PowerPoint is not running.$\r$\n$\r$\n$_CLICK" 288 | --------------------------------------------------------------------------------