Perl 处理excel文件

最近写了一个自动处理DICOM协议tag评估的小程序.基本思路是讲抓到的DICOM分析包,存储成文本文件,然后根据Excel中定义的DICOM协议tag在文本中查找,比对.同时将比对的结果保存到相应的excel文件中.

程序中用到了一些perl处理excel的部分.开始当然啥都不知道,Google了一把后找到了一个例程(忘记从哪里来的了,欢迎砖头指正),还是蛮好用的.后来根据自己的一些经验又进行了一定的整理.把相关的程序贴到这里,供有需要的朋友参考,欢迎讨论.

use strict;

use Cwd;

use Time::Local;

use Win32::OLE qw(in with);

use Win32::OLE::Const 'Microsoft Excel';

my $ex;

my $dir = getcwd;

my $file_name = "test1.xls";

# use existing instance if Excel is already running

#About how to use the Win32::OLE, please read the help document. the manual is a part of the manual of office ,you can find it in your system if you installed the Windows Family Office software

#the path location is C:/Program Files/Microsoft Office/OFFICE11/1033,the file name is VBAXL10.CHM

#In advance, I find there are many manuals about the Win32::OLE, such as VBAWD10.CHM is for "Word Object Model";

#VBAPP10.chm is for "PowerPoint Object Model"

#VBAPB10.CHM is for "Publisher Object Model "

#VBAOL11.CHM is for "Outlook Object Model"

#XMLSDK5.CHM is for "MSXML 5.0 SDK"

#and so on. 

$ex = Win32::OLE->new('Excel.Application', sub {$_[0]->Quit;}) or die "Oops, cannot start Excel";

# get a new workbook

$ex->{DisplayAlerts} = 'True'; 

my $book = $ex->Workbooks->Add;

$book->SaveAs($dir.$file_name);

#$book->SaveAs($file_name);

# 各色操作

my $sheet = $book->Worksheets("Sheet1"); #sheet对象

#$sheet->Columns("B:Q")->{ColumnWidth} = 10; #设置列宽

$sheet->{Name}= "Main"; # sheet改名

$book->Worksheets("Sheet2")->Delete; #删掉sheet2

# 单元格赋值

my $rng = $sheet->Range('A1');

$rng->{value} = "第一格"; #单个单元格赋值

my $rng1 = $sheet->Range('C20');

$rng1->{value} = "第一格";

$rng1->{value} = "zhongguojinpai";

my $array;

$array->[0][0] = "熊伯";

$array->[0][1] = "熊仲";

$array->[0][2]= "熊叔";

$rng = $sheet->Range("A2:C2");

$rng->{'NumberFormat'}="/@";

# let the cell as txt format'

$rng->{Value} = $array;

$array->[0][0] = "大熊";

$array->[1][0] = "二熊";

$array->[2][0] = "三熊";

$rng = $sheet->Range("A3:A5");

$rng->{Value} = $array;

#从单元格读取

my $val = $sheet->Range('A1')->{value};

print "从Excel中读取A1格子:$val/n";

# save and exit

print "finish";

$book->Save();

$ex->Quit;

undef $book;

undef $ex;