Guest User

Untitled

a guest
May 21st, 2018
127
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.99 KB | None | 0 0
  1. #!/usr/bin/perl
  2.  
  3. use strict;
  4. use warnings;
  5.  
  6. use FindBin qw( $Bin );
  7. use File::Spec::Functions qw( catfile );
  8.  
  9. use Win32::OLE;
  10. use Win32::OLE::Const 'Microsoft PowerPoint';
  11. $Win32::OLE::Warn = 3;
  12.  
  13. my $ppt = get_ppt();
  14. $ppt->{Visible} = 1;
  15.  
  16. my $ppt_file = catfile $Bin, 'test.ppt';
  17. my $doc = $ppt->Presentations->open( $ppt_file );
  18. my $slides = $doc->Slides;
  19. my $num_slides = $slides->Count;
  20.  
  21. for my $slide_idx (1 .. $num_slides) {
  22. print "=== Begin Slide $slide_idx ===n";
  23.  
  24. my $slide = $doc->Slides->Item( $slide_idx );
  25. my $shapes = $slide->Shapes;
  26. my $num_shapes = $shapes->Count;
  27.  
  28. for my $shape_idx (1 .. $num_shapes) {
  29. my $shape = $shapes->Item($shape_idx);
  30. next unless $shape->HasTextFrame;
  31.  
  32. my $pars = $shape->TextFrame->TextRange->Paragraphs;
  33. my $num_pars = $pars->Count;
  34. for my $par_idx (1 .. $num_pars) {
  35. my $par = $pars->Paragraphs($par_idx,1);
  36. print_par( $par );
  37. }
  38. }
  39.  
  40. print "=== End Slide $slide_idx ===nn";
  41. }
  42.  
  43. sub print_par {
  44. my ($par) = @_;
  45. my @bullets = qw( - * > + = @ );
  46.  
  47. my $bullet_format = $par->ParagraphFormat->Bullet;
  48. my $bullet_type = $bullet_format->Type;
  49.  
  50. my $bullet_char = '';
  51.  
  52. if ($bullet_type == ppBulletNumbered) {
  53. $bullet_char = $bullet_format->Number . "t";
  54. }
  55. elsif( $bullet_type == ppBulletUnnumbered ) {
  56. # Need a Unicode => ASCII mapping if you want to use
  57. # $bullet_format->Character
  58. my $indent = $par->IndentLevel % scalar @bullets;
  59. $bullet_char = $bullets[$indent] . "t";
  60. }
  61.  
  62. my $text = $par->Text;
  63. $text =~ s/s+$//;
  64.  
  65. print $bullet_char, $text,"n";
  66. }
  67.  
  68. sub get_ppt {
  69. my $app;
  70. eval {
  71. $app = Win32::OLE->GetActiveObject('PowerPoint.Application');
  72. };
  73.  
  74. die "$@n" if $@;
  75.  
  76. unless($app) {
  77. $app = Win32::OLE->new(
  78. 'PowerPoint.Application', sub { $_[0]->Quit }
  79. ) or die "Oops, cannot start PowerPoint: ",
  80. Win32::OLE->LastError, "n";
  81. }
  82. return $app;
  83. }
Add Comment
Please, Sign In to add comment