perl操作ppt自动化报告

aef25u

win32ppt.zip (292.18 KB, 下载次数: 4)

2017-04-04 00:19 上传

点击文件名下载附件
源文件

直接上代码：

1. package Win32::PPT;
   
2. use Moose;
   
3. use Win32::OLE;
   
4. use MooseX::NonMoose::InsideOut;
   
5. use Data::Printer;
   
6. 
   
7. extends 'Win32::PowerPoint';
   
8. 
   
9. my $intro=<<'EOF';
   
10. 
    
11. ########################################################
    
12. #                   Win32::PPT模块
    
13. #      Author: TianYv
    
14. #      Blog: http://tianyv.github.io
    
15. #      Blog: http://blog.chinaunix.net/uid/22674875.html
    
16. ########################################################
    
17. EOF
    
18. p $intro;
    
19. 
    
20. has config => (
    
21.     is      => 'rw',
    
22.     default => sub { {} }
    
23. );
    
24. 
    
25. has app => ( is => 'rw' );
    
26. 
    
27. #通过PPT vba增加打开方法
    
28. sub open_ppt {
    
29.     my ( $self, $file ) = @_;
    
30.     return unless defined $file;
    
31. 
    
32.     $self->{app} = Win32::OLE->GetActiveObject('PowerPoint.Application');
    
33.     $self->{app}->{Visible} = 1;
    
34.     my $objppt = $self->{app}->Presentations->Open($file);
    
35.     return $self;
    
36. }
    
37. 
    
38. #重写创建PPT方法
    
39. sub new_ppt {
    
40.     my $self = shift;
    
41.     $self->new_presentation(
    
42.         background_forecolor => [ 255, 255, 255 ],
    
43.         background_backcolor => 'RGB(255,255,255)',
    
44.     );
    
45. }
    
46. 
    
47. #新建幻灯片，并输入Title和Body文字
    
48. sub slide2TB {
    
49.     my ( $self, $texTitle, $texBody, $hT, $hB ) = @_;
    
50.     $hT = ref($hT) eq 'HASH' ? $hT : $self->{config}->{title};
    
51.     $hB = ref($hB) eq 'HASH' ? $hB : $self->{config}->{body};
    
52.     $self->new_slide();
    
53.     $self->add_text( $texTitle, $hT );
    
54.     $self->add_text( $texBody,  $hB );
    
55. }
    
56. 
    
57. #新建幻灯片，并输入Title和Picture文字
    
58. sub slide2TP {
    
59.     my ( $self, $texTitle, $img, $hT, $hP ) = @_;
    
60.     $hT = ref($hT) eq 'HASH' ? $hT : $self->{config}->{title};
    
61.     $hP = ref($hP) eq 'HASH' ? $hP : $self->{config}->{picture};
    
62.     $self->new_slide();
    
63.     $self->add_text( $texTitle, $hT );
    
64.     $self->add_picture( $img, $hP );
    
65. 
    
66. }
    
67. 
    
68. #$hash={texT=>,texB=>,img=>,type=>}
    
69. sub slide2TBBPP {
    
70.     my ( $self, $hash, $hT, $hB, $hP ) = @_;
    
71.     $hT = ref($hT) eq 'HASH' ? $hT : $self->{config}->{def_tbp}->{title};
    
72.     $hB = ref($hB) eq 'HASH' ? $hB : $self->{config}->{def_tbp}->{body};
    
73.     $hP = ref($hP) eq 'HASH' ? $hP : $self->{config}->{def_tbp}->{picture};
    
74.     my ( $texTitle, $texBody, $img );
    
75.     if ( ref($hash) eq 'HASH' ) {
    
76.         $texTitle = defined( $hash->{texT} ) ? $hash->{texT} : '标题定义错误！';
    
77.         $texBody  = defined( $hash->{texB} ) ? $hash->{texB} : '正文定义错误！';
    
78.         $img      = defined( $hash->{img} )  ? $hash->{img}  : '';
    
79.     }
    
80.     $self->new_slide();
    
81.     $self->add_text( $texTitle, $hT );
    
82. 
    
83.     my $type = $hash->{type};
    
84.     if ( $type == 1 ) {
    
85.         $self->add_text( $texBody, $hB );
    
86.         $self->add_picture( $img, $hP );
    
87.     }
    
88.     else {
    
89.         $self->add_picture( $img, $hP );
    
90.         $self->add_text( $texBody, $hB );
    
91.     }
    
92. }
    
93. 
    
94. #重写创建PPT保存并关闭方法，保存在当前文件夹
    
95. sub save_ppt {
    
96.     my ( $self, $name ) = @_;
    
97.     $self->save_presentation($name);
    
98.     $self->close_presentation();
    
99.     $self->quit();
    
100. }
     
101. 
     
102. package main;
     
103. use Cwd;
     
104. use File::Spec;
     
105. use YAML::Syck;
     
106. use Data::Printer;
     
107. 
     
108. my $ppt  = Win32::PPT->new();
     
109. my $dir  = Cwd::getcwd();
     
110. my $file = $dir . '/模板.ppt';
     
111. 
     
112. #读取配置文件config.yaml信息：设置(title body picture)位置；
     
113. #设置字体名称[name]、字体大小[size]、字体是否加粗[bold]、图片宽高[width | hight]
     
114. #如$ppt->{config}->{body}->{size} 为正文字体大小
     
115. my $confile = File::Spec->rel2abs('config.yaml');
     
116. $ppt->{config} = LoadFile($confile);
     
117. 
     
118. #p $ppt->{config};
     
119. #$ppt->new_ppt();
     
120. 
     
121. #打开模版PPT
     
122. $ppt->open_ppt($file);
     
123. 
     
124. #1.1使用config.yaml内设的默认属性
     
125. $ppt->slide2TB( '一、测试标题', '测试正文' );
     
126. 
     
127. #1.2可以改变局部属性，如$ht ，也可像$hb一样更改所有属性
     
128. my $ht = {
     
129.     top  => 40,
     
130.     size => 24,
     
131.     name => '楷体'
     
132. };
     
133. my $hb = {
     
134.     left   => 35,
     
135.     top    => 85,
     
136.     width  => 625,
     
137.     height => 400,
     
138.     size   => 24,
     
139.     bold   => 1,
     
140.     name   => '宋体'
     
141. };
     
142. $ppt->slide2TB( '一、测试标题', '测试正文', $ht, $hb );
     
143. 
     
144. #2.1使用config.yaml内设的默认属性;插入图片
     
145. $ppt->slide2TP( '二、测试标题图片', 'img/jx.png' );
     
146. 
     
147. #2.2更改图片局部属性
     
148. my $hp = {
     
149.     width  => 200,
     
150.     height => 130,
     
151. };
     
152. $ppt->slide2TP( '二、测试标题图片', 'img/jx.png', $ht, $hp );
     
153. 
     
154. #3.1左右2列的幻灯片,type=1,左正文+右图片
     
155. my $h1 = {
     
156.     texT => '三、左正文+右图片',
     
157.     texB => '1234567890正文',
     
158.     img  => 'img/3D.png',
     
159.     type => 1
     
160. };
     
161. $ppt->slide2TBBPP($h1);
     
162. 
     
163. #3.2上下2列的幻灯片,type=0,上图片+下正文
     
164. my $h2 = {
     
165.     texT => '三、上图片+下正文',
     
166.     texB => '1234567890正文',
     
167.     img  => 'img/3D.png',
     
168.     type => 0
     
169. };
     
170. my $hb2 = {
     
171.     top    => 450,
     
172.     height => 200,
     
173. };
     
174. my $hp2 = {
     
175.     top    => 85,
     
176.     width  => 400,
     
177.     height => 360,
     
178. };
     
179. $ppt->slide2TBBPP( $h2, $ht, $hb2, $hp2 );
     
180. $ppt->save_ppt("结果.ppt");
     

复制代码