Schrift
Start · Board · Beiträge im Abseits · Projekte
[thread]4598[/thread]

excelPerl (Seite 2)

Leser: 3


<< |< 1 2 >| >> 16 Einträge, 2 Seiten
esskar
 2006-11-06 22:17
#38941 #38941
User since
2003-08-04
7321 Artikel
ModeratorIn

user image
hab kein excel.
was macht das monster denn?
Strat
 2006-11-06 22:27
#38942 #38942
User since
2003-08-04
5246 Artikel
ModeratorIn
[Homepage] [default_avatar]
@esskar: von welchem monster sprichst du?
perl -le "s::*erlco'unaty.'.dk':e,y;*kn:ai;penmic;;print"
http://www.fabiani.net/
Strat
 2006-11-18 20:22
#38943 #38943
User since
2003-08-04
5246 Artikel
ModeratorIn
[Homepage] [default_avatar]
Eine neue Version ist fertig:

xlsPerl.pl
Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
#! /usr/bin/perl
use warnings;
use strict;

use Getopt::Long;
use File::Basename;
use XlsPerl;

$|++; # no suffering from buffering

my( $file, $perlCode );
my $worksheetNumber = 1;
my $headline        = 0;
my $visible         = 0;
my $colSeparator    = "\t";

GetOptions( 'file=s'       => \$file,
            'sheet=i'      => \$worksheetNumber,
            'headline=i'   => \$headline,
            'ane=s'        => \$perlCode,
            'visible'      => \$visible,
            'colseparator' => \$colSeparator,
       ) or die &PrintUsage();

my $xlsPerl = XlsPerl->new( excelFile       => $file,
                            worksheetNumber => $worksheetNumber,
                       )
    ->open;

#if( $visible ) {
    $xlsPerl->excel->{Visible} = 1;
#} # if

# skip all lines until -headline if available
$xlsPerl->currentRow( $headline ) if $headline;

# TODO: the global @F is dirty... use a better way, e.g. with alias
use vars qw(@F);
while( $xlsPerl->getNextRow ) {
    my $R = $xlsPerl->currentRow();
    local $_ = join($colSeparator, @F ) . "\n";

    eval $perlCode;
    die $@ if $@;

} # while

# ------------------------------------------------------------
sub PrintUsage {

    my $bin = File::Basename::basename($0);
    die <<EOH;
$bin -file filename -sheet 1 -headline 1 -visible

try perldoc $bin for more details

EOH

} # PrintUsage
# ------------------------------------------------------------

=pod

=head1 xlsPerl

You know about the perl parameters -ane? This script is a way to try to do
the same thing to Excel files. But although working somehow, it isn't finished.

=head1 Prerequisites

=over 1

=item Win32::OLE

=item Excel needs to be installed

=back

=head1 Description

This script xlsPerl.pl loops over an excel file row by row (like
perl -ne). It splits the cells into an array with name @F (like perl -ane),
and executes a given bit of perl code for each row.

If you modify elements of @F, you modify the excel cell the value comes from.
Beware: this feature is still very experimental

=head1 Params:

  -file            String:  Name of excel file (full path)
#  -visible         Boolean: make excel visible (funny, but not yet useful)
  -sheetnumber     Integer: which sheet shell I read (1..n, default: 1)
  -headline        Integer: line number of headline (used for skipping headline)
  -ane             String:  Perl-Code to execute
  -colseparator    String:  how to join columns in $_ (default: \t)

Abbreviations of params are allowed, as long as they are unique, e.g

  xlsPerl.pl -s 2 -m 10 -ane "print qq~$R: $F[0] $F[5]\n" -f c:\test.xls

=head1 Special Variables:

  $R               Row number
  @F               Array containing the values of one complete row
  $_               Row joined by -colseparator, with \n at the end

=head1 Bugs/...

This code is very, very, very experimental, and some parts are dirty!

If you do changes, you have to save the workbook by yourself, that's the
reason why the parameter -visible always is on.

=head1 Author

Martin Fabiani L<http://www.fabiani.net/>

=cut


XlsPerl.pm
Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
package XlsPerl;
use warnings;
use strict;
use Carp qw(croak);

#use Readonly;
use Win32::OLE;
use Win32::OLE::Const 'Microsoft Excel';
use Win32::OLE::Variant;
Win32::OLE->Option( Warn => 3);

use vars qw( @ObjInterfaceMethods );

# which object interface methods shell be available as standard
#Readonly::Array
@ObjInterfaceMethods =
    qw( excelFile excel workBook worksheet
        worksheetNumber currentRow lastRow changeCount
       );

# install object interface methods at startup
foreach my $method ( @ObjInterfaceMethods ) {
    no strict 'refs';
    *{ $method } = sub {
        my( $self, @values ) = @_;
        $self->{ $method } = $values[0] if scalar @values;
        return $self->{ $method };
    };
} # foreach

# ============================================================
sub new {
    my( $class, %params ) = @_;

    my $self = bless {}, $class;
    foreach my $param (keys %params) {
        $self->$param( $params{$param} );
    } # foreach

    return $self;
} # new
# ------------------------------------------------------------
sub DESTROY {
#    my $self = shift;
#    print "DESTROY: ", ref $self->excel, "\n";
} # DESTROY
# ------------------------------------------------------------
sub increaseCurrentRow {
    my $self = shift;
    $self->currentRow( 1 + $self->currentRow );
} # increaseCurrentRow
# ------------------------------------------------------------
sub increaseChangeCount {
    my $self = shift;
    $self->changeCount( 1 + $self->changeCount );
} # increaseChangeCount
# ------------------------------------------------------------
sub open {
    my( $self ) = @_;

    my $filename = $self->excelFile;
    defined $filename or croak "Error: no filename given";
    -f $filename or croak( "Error: filename '$filename' doesn't exist");

    my $excel; # try to re-use running instance of Excel
    eval { $excel = Win32::OLE->GetActiveObject( 'Excel.Application' ) };
    die "Error: no Excel installed\n" if $@;

    unless( defined $excel ) { # if not running, start excel
        $excel = Win32::OLE->new( 'Excel.Application', sub { $_[0]->Quit } )
            or die "Error: can't start Excel\n";
    } # unless
    $self->excel( $excel );

    $self->workBook( $excel->Workbooks->Open( $filename ) );

    $self->worksheet( $self->workBook->Worksheets( $self->worksheetNumber ) );

    my $range = $self->worksheet->UsedRange->{Value};
    $self->lastRow( $#$range + 1 );

    $self->currentRow( 0 );

    return $self;
} # open
# ------------------------------------------------------------
sub getNextRow {
    my( $self ) = @_;

    $self->increaseCurrentRow;

    my $row   = $self->currentRow;
    my $sheet = $self->worksheet;
    return if $row > $self->lastRow;

    my $rowData = $sheet->Range("A$row:IV$row")->{Value}; # dirty
    my $itemsFound = 0;

    tie( @::F, 'XlsPerl::RowArray', $self );

    foreach my $value ( reverse @{ $rowData->[0] } ) {
        if( defined $value ) { unshift( @::F, $value ); $itemsFound++; }
        else                 { unshift( @::F, ''     ) if scalar @::F; }
    } # foreach

    return 1;
} # getNextRow
# ------------------------------------------------------------

# ============================================================
package XlsPerl::RowArray;
# ------------------------------------------------------------
use Tie::Array;
use vars qw(@ISA);
@ISA = qw(Tie::Array);
# ------------------------------------------------------------
sub TIEARRAY {
    my( $class, $excelObj ) = @_;

    my $self = bless( { data => [] }, $class );
    $self->{excelObj} = $excelObj;
    $self->{row} = $excelObj->currentRow;

    return $self;
} # TIEARRAY
# ------------------------------------------------------------
sub FETCH {
    my( $self, $index) = @_;
    return $self->{data}->[ $index ];
} # FETCH
# ------------------------------------------------------------
sub STORE {
    my( $self, $index, $value ) = @_;

    my $excelObj = $self->{excelObj};
    my $sheet    = $excelObj->worksheet;

    my $row = $excelObj->currentRow;
    my $col = $index + 1;

#    print "### UPDATE: $row/$col\n";
#    print "OLD: '$self->{data}->[ $index ]'\n";
#    print "NEW: '$value'\n\n";

    if( $self->{data}->[$index] ne $value ) {
        $excelObj->increaseChangeCount;
        $sheet->Cells($row, $col)->{Value} = $value;
        $self->{data}->[ $index ] = $value;
    } # if

} # STORE
# ------------------------------------------------------------
sub FETCHSIZE {
    my $self = shift;
    return $#{ $self->{data} };
} # FETCHSIZE
# ------------------------------------------------------------
sub STORESIZE {
    my( $self, $newLength ) = @_;
    print "### STORESIZE\n";
    $#{ $self->{data} } = $newLength;
} # STORESIZE
# ------------------------------------------------------------
sub UNSHIFT {
    my $self = shift;
#    print "### UNSHIFT @_\n";
    unshift( @{ $self->{data} }, @_ );
} # UNSHIFT
# ------------------------------------------------------------
sub SHIFT {
    my $self = shift;
    print "### SHIFT\n";
    return shift @{ $self->{data} };
} # SHIFT
# ------------------------------------------------------------
sub POP {
    my $self = shift;
    print "### POP\n";
    return pop @{ $self->{data} };
} # POP
# ------------------------------------------------------------
sub PUSH {
    my $self = shift;
    print "### PUSH\n";
    push( @{ $self->{data} }, @_ );
} # PUSH
# ------------------------------------------------------------
sub CLEAR {
    my( $self ) = @_;
    print "### CLEAR\n";
    # TODO: update excel
    $self->{data} = [];
} # CLEAR
# ------------------------------------------------------------
sub DESTROY {
#    my $self = shift;
} # DESTROY
# ------------------------------------------------------------
# sub EXISTS {
# } # EXISTS
# ------------------------------------------------------------
# sub DELETE {
# } # DELETE
# ------------------------------------------------------------
# ...
# ------------------------------------------------------------
1; # modules have to return a true value
perl -le "s::*erlco'unaty.'.dk':e,y;*kn:ai;penmic;;print"
http://www.fabiani.net/
Strat
 2007-01-11 22:20
#38944 #38944
User since
2003-08-04
5246 Artikel
ModeratorIn
[Homepage] [default_avatar]
excelPerl v0.08a gibt's jetzt, und endlich einigermaszen sauber.

Bitte um Feedback.

Datei: excelPerl.pl
Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
#! /usr/bin/perl
use warnings;
use strict;

use Win32;          # automatically loaded with Activestate Perl
use File::Basename; # for PrintUsage
use Getopt::Long;   # for parsing program arguments
use FindBin;
use lib $FindBin::Bin;
use ExcelPerl;

$|++; # no suffering from buffering

my( $file, $perlCode );
my $worksheetNumber = 1;    # use first worksheet as default
my $headline        = 0;    # don't skip a headline as default
my $visible         = 0;    # is of no use in this version
my $colSeparator    = "\t"; # standard col separator for $_

GetOptions( 'file=s'       => \$file,
            'sheet=i'      => \$worksheetNumber,
            'headline=i'   => \$headline,
            'ane=s'        => \$perlCode,
#            'visible'      => \$visible,
            'colseparator' => \$colSeparator,
       ) or die &PrintUsage();

die &PrintUsage() unless defined $file;
$file = Win32::GetFullPathName( $file );

my $xlsPerl = ExcelPerl->new( excelFile       => $file,
                            worksheetNumber => $worksheetNumber,
                       )
    ->open;

#if( $visible ) {
$xlsPerl->excel->{Visible} = 1;
#} # if

# skip all lines until -headline if available
$xlsPerl->currentRow( $headline ) if $headline;

my @F;
while( $xlsPerl->getNextRow( \@F ) ) {

    # create an alias to @ExcelPerl::F; to be able to access it, it needs to
    # be a package variable, declared with our or use vars

    # prepare some other helpful variables
    local $. = $xlsPerl->currentRow();
    local $_ = join($colSeparator, @F ) . "\n";

    # try to eval the perl code
    eval $perlCode;
    die $@ if $@;

    @F = ();
} # while

# ------------------------------------------------------------
sub PrintUsage {

    my $bin = File::Basename::basename($0);
    die <<EOH;
$bin -sheet 1 -headline 1 -ane "print qq~\$.: \$F[0], \$F[1]\\n~" -file excelFile

try perldoc $bin for more details

EOH

} # PrintUsage
# ------------------------------------------------------------

=pod

=head1 excelPerl

You know about the perl parameters -ane? This script is a way to try to do
the same thing to Excel files.

=head1 Prerequisites

=over 1

=item Win32::OLE

=item Excel needs to be installed

=back

=head1 Description

Like perl -ane with a plaintext file, excelPerl.pl loops over an excel file
and automatically (-a) splits up the columns of one row into an array with
name @F. Since @F is an alias to a tied array, by changing one element of @F
you change the content of the excel cells.

If you need one whole line with a tailing \n, you can use the variable $_
(like perl -ne) which joins @F by the value given in the parameter
-colseparator (default: \t)

If you need to know the current line number (like $. for while), you can use
the special variable $. (big surprise).

=head1 Params:

  -file            String:  Name of excel file (full path!)
  -sheetnumber     Integer: which sheet shell I read (1..n, default: 1)
  -headline        Integer: line number of headline (used for skipping headline)
  -ane             String:  Perl-Code to execute
  -colseparator    String:  how to join columns in $_ (default: \t)

Abbreviations of params are allowed, as long as they are unique, e.g

  excelPerl.pl -s 2 -h 1 -ane "print qq~$.: $F[0] $F[5]\n" -f c:\test.xls

=head1 Special Variables:

  $.               Row number
  @F               Array containing the values of one complete row
  $_               Row joined by -colseparator, with \n at the end

=head1 Bugs/...

This code is very, very, very experimental!

If you do changes, you better save the workbook manually, that's the
reason why the parameter -visible always is on.

=head1 SEE ALSO

I heard about XLSperl from John Allen which is a great tool. But it only
allows to read excel files and not to change them on the fly. Since I
often need this feature, I decided to write it with Win32::OLE, and it
was not difficult. But unlike XLSperl, excelPerl only runs under Windows
and needs an installed version of Excel.

You can find XLSPerl at L<http://perl.jonallen.info/projects/xlstools>

=head1 Author

Martin Fabiani L<http://www.fabiani.net/>

=cut

Datei: excelPerl.pm
Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
package ExcelPerl;
use warnings;
use strict;
use Carp qw(croak);

our $VERSION = 0.08;

# use Readonly; # better not, since Readonly is no standard module yet
use Win32::OLE;
use Win32::OLE::Const 'Microsoft Excel';
use Win32::OLE::Variant;
Win32::OLE->Option( Warn => 3);

use vars qw( @ObjInterfaceMethods @F );

# which object interface methods shell be available as standard
#Readonly::Array: Readonly is not yet a standard module :-(
@ObjInterfaceMethods =
    qw( excelFile excel workBook worksheet
        worksheetNumber currentRow lastRow changeCount
       );

# install object interface methods at startup
foreach my $method ( @ObjInterfaceMethods ) {
    no strict 'refs'; # Sub::Install is no standard module :-(
    *{ $method } = sub {
        my( $self, @values ) = @_;
        $self->{ $method } = $values[0] if scalar @values;
        return $self->{ $method };
    };
} # foreach

# ============================================================
sub new {
    my( $class, %params ) = @_;

    my $self = bless {}, $class;
    foreach my $param (keys %params) {
        $self->$param( $params{$param} );
    } # foreach

    return $self;
} # new
# ------------------------------------------------------------
sub DESTROY {
#    my $self = shift;
#    print "DESTROY: ", ref $self->excel, "\n";
} # DESTROY
# ------------------------------------------------------------
sub increaseCurrentRow {
    my $self = shift;
    $self->currentRow( 1 + $self->currentRow );
} # increaseCurrentRow
# ------------------------------------------------------------
sub increaseChangeCount {
    my $self = shift;
    no warnings;
    $self->changeCount( 1 + $self->changeCount );
} # increaseChangeCount
# ------------------------------------------------------------
sub open {
    my( $self ) = @_;

    my $filename = $self->excelFile;
    defined $filename or croak "Error: no filename given";
    -f $filename or croak( "Error: filename '$filename' doesn't exist");

    my $excel; # try to re-use running instance of Excel
    eval { $excel = Win32::OLE->GetActiveObject( 'Excel.Application' ) };
    die "Error: no Excel installed\n" if $@;

    unless( defined $excel ) { # if not running, start excel
        $excel = Win32::OLE->new( 'Excel.Application', sub { $_[0]->Quit } )
            or die "Error: can't start Excel\n";
    } # unless
    $self->excel( $excel );

    $self->workBook( $excel->Workbooks->Open( $filename ) );

    $self->worksheet( $self->workBook->Worksheets( $self->worksheetNumber ) );

    my $range = $self->worksheet->UsedRange->{Value};
    $self->lastRow( $#$range + 1 );

    $self->currentRow( 0 );

    return $self;
} # open
# ------------------------------------------------------------
sub getNextRow {
    my( $self, $F ) = @_;

    $self->increaseCurrentRow;

    my $row   = $self->currentRow;
    my $sheet = $self->worksheet;
    return if $row > $self->lastRow;

    my $rowData = $sheet->Range("A$row:IV$row")->{Value}; # dirty
    my $itemsFound = 0;

    tie( @$F, 'ExcelPerl::RowArray', $self );

    foreach my $value ( reverse @{ $rowData->[0] } ) {
        if( defined $value ) { unshift( @$F, $value ); $itemsFound++; }
        else                 { unshift( @$F, ''     ) if scalar @$F; }
    } # foreach

    return 1;
} # getNextRow
# ------------------------------------------------------------

# ============================================================
package ExcelPerl::RowArray;
# ------------------------------------------------------------
use Tie::Array;
use vars qw( @ISA );
@ISA   = qw( Tie::Array );
# ------------------------------------------------------------
sub TIEARRAY {
    my( $class, $excelObj ) = @_;

    my $self = bless( { data => [] }, $class );
    $self->{excelObj} = $excelObj;
    $self->{row} = $excelObj->currentRow;

    return $self;
} # TIEARRAY
# ------------------------------------------------------------
sub FETCH {
    my( $self, $index) = @_;
    return $self->{data}->[ $index ];
} # FETCH
# ------------------------------------------------------------
sub STORE {
    my( $self, $index, $value ) = @_;

    my $excelObj = $self->{excelObj};
    my $sheet    = $excelObj->worksheet;

    my $row = $excelObj->currentRow;
    my $col = $index + 1;

    if( $self->{data}->[$index] ne $value ) {
        $excelObj->increaseChangeCount;
        $sheet   ->Cells($row, $col)->{'Value' } = $value;
        $self    ->{'data'}         ->[ $index ] = $value;
    } # if

} # STORE
# ------------------------------------------------------------
sub FETCHSIZE {
    my $self = shift;
    return $#{ $self->{data} };
} # FETCHSIZE
# ------------------------------------------------------------
sub STORESIZE {
    my( $self, $newLength ) = @_;
    $#{ $self->{data} } = $newLength;
} # STORESIZE
# ------------------------------------------------------------
sub UNSHIFT {
    my $self = shift;
    unshift( @{ $self->{data} }, @_ );
} # UNSHIFT
# ------------------------------------------------------------
sub SHIFT {
    my $self = shift;
    return shift @{ $self->{data} };
} # SHIFT
# ------------------------------------------------------------
sub POP {
    my $self = shift;
    return pop @{ $self->{data} };
} # POP
# ------------------------------------------------------------
sub PUSH {
    my $self = shift;
    push( @{ $self->{data} }, @_ );
} # PUSH
# ------------------------------------------------------------
sub CLEAR {
    my( $self ) = @_;
    # TODO: update excel
    $self->{data} = [];
} # CLEAR
# ------------------------------------------------------------
sub DESTROY {
#    my $self = shift;
} # DESTROY
# ------------------------------------------------------------
# sub EXISTS {
# } # EXISTS
# ------------------------------------------------------------
# sub DELETE {
# } # DELETE
# ------------------------------------------------------------
# ...
# ------------------------------------------------------------
1; # modules have to return a true value


update (dank an pKai):
x) um warnungen zu vermeiden, abfrage ob $file defined vor $file = Win32::GetFullPathName( $file );
x) $. und \n in PrintUsage backslashed\n\n

<!--EDIT|Strat|1168598931-->
perl -le "s::*erlco'unaty.'.dk':e,y;*kn:ai;penmic;;print"
http://www.fabiani.net/
Strat
 2007-01-21 05:54
#38945 #38945
User since
2003-08-04
5246 Artikel
ModeratorIn
[Homepage] [default_avatar]
Hallo Leute,

da ich heute irgendwie nicht einschlafen konnte, gibt's eine neue Version v0.10. Die hat als Erweiterung eine Liste namens @c (ich ueberlege noch, ob ich sie nicht @C nennen sollte), die Zugriff auf die Attribute der Zellen einer Reihe gibt (z.B. setzen oder auslesen von Formaten, Ausrichtungen, ...)

Datei excelPerl.pl:
Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
#! /usr/bin/perl
use warnings;
use strict;

our $VERSION = 0.10;

use Win32;          # automatically loaded with Activestate Perl
use File::Basename; # for PrintUsage
use Getopt::Long;   # for parsing program arguments
use FindBin;
use lib $FindBin::Bin;
use ExcelPerl;
use Win32::OLE::Const 'Microsoft Excel';

$|++; # no suffering from buffering

my( $file, $perlCode );
my $worksheetNumber = 1;    # use first worksheet as default
my $headline        = 0;    # don't skip a headline as default
my $colSeparator    = "\t"; # standard col separator for $_

GetOptions( 'file=s'       => \$file,
            'sheet=i'      => \$worksheetNumber,
            'headline=i'   => \$headline,
            'ane=s'        => \$perlCode,
            'colseparator' => \$colSeparator,
       ) or die &PrintUsage();

# check file and convert it to absolute path if necessary
defined $file or die &PrintUsage();
$file = Win32::GetFullPathName( $file );

my $xlsPerl = ExcelPerl->new( excelFile       => $file,
                              worksheetNumber => $worksheetNumber,
                       )
    ->open;

$xlsPerl->excel->{Visible} = 1;

# skip all lines until -headline if available
$xlsPerl->currentRow( $headline ) if $headline;
$xlsPerl->colSeparator( $colSeparator );

# evaluate the perl code from argument -ane ( thanks @pKai for the idea )
my $aneCode = eval "sub {
    my \$xlsPerl = shift;
    my \$c = shift;
    my \@c = \@\$c;
    my \@F = \@_;

    # prepare some other helpful variables
    local \$. = \$xlsPerl->currentRow();
    no warnings \'uninitialized\';
    local \$_ = join( \$xlsPerl->colSeparator, \@F ) . \"\\n\";
    $perlCode;
}";
die $@ if $@;

my @F;
while( my @cells = $xlsPerl->getNextRow( \@F ) ) {
    $aneCode->($xlsPerl, \@cells, @F);
} # while

# ------------------------------------------------------------
sub PrintUsage {

    my $bin = File::Basename::basename($0);
    die <<EOH;
$bin -sheet 1 -headline 1 -ane "print qq~\$.: \$F[0], \$F[1]\\n~" -file excelFile

try perldoc $bin for more details

EOH

} # PrintUsage
# ------------------------------------------------------------

=pod

=head1 excelPerl

You know about the perl parameters -ane? This script is a way to try
to do the same thing to Excel files.

=head1 Prerequisites

=over 1

=item Win32::OLE

=item Excel needs to be installed

=back

=head1 Description

Like perl -ane with a plaintext file, excelPerl.pl loops over an excel
file and automatically (-a) splits up the columns of one row into an
array with the name @F. Since @F is a ied array, by changing one
element of @F you change the content of the excel cells.

If you need one whole line with a tailing \n, you can use the variable
$_ (like perl -ne) which joins @F by the value given in the parameter
-colseparator (default: \t)

If you need to know the current line number (like $. for while), you
can use the special variable $. (big surprise).

=head1 Params:

  -file            String:  Name of excel file (full path!)
  -sheetnumber     Integer: which sheet shell I read (1..n, default: 1)
  -headline        Integer: line number of headline (used for skipping headline)
  -ane             String:  Perl-Code to execute
  -colseparator    String:  how to join columns in $_ (default: \t)

Abbreviations of params are allowed, as long as they are unique, e.g

  excelPerl.pl -s 2 -h 1 -ane "print qq~$.: $F[0] $F[5]\n~" -f c:\test.xls

  excelPerl.pl -ane "$c[0]->{Font}->{Name} = 'Courier New'" -f c:\test.xls

=head1 Special Variables:

  $.    Row number
  @F    Array containing the values of one complete row
  $_    Row joined by -colseparator, with \n at the end
  @c    Advanced: List of cells (e.g. to change a format). You may even
        use excel constants.

=head2 Some examples for $c[$i]-> ($i is index of column):

  {Font}->{Name}           name of font: 'Courier New', 'Arial', ...
  {Font}->{FontStyle}      style of font: 'Bold Italic', ...
  {Font}->{Size}           font size: ... 10 11 12 ...
  {Font}->{Strikethrough}  strike through: 0 or 1
  {HorizontalAlignment}    align: xlCenter, xlRight, xlLeft, xlJustify
  {VerticalAlignment}      align vertically: xlCenter, xlTop, xlBottom
  {WrapText}               wrap text in line: 0 or 1
  {FormulaR1C1}            formula: "=CONCATENATE(RC[-1],$R[-1]C[-1])"

=head1 Bugs/...

This code is very, very, very experimental!

If you do changes, you better save the workbook manually, that's the
reason why the parameter -visible always is on.

=head1 SEE ALSO

I heard about XLSperl from John Allen which is a great tool. But it
only allows to read excel files and not to change them on the fly.
Since I often need this feature, I decided to write it with
Win32::OLE, and it was not difficult. But unlike XLSperl, excelPerl
only runs under Windows and needs an installed version of Excel. But
starting with v0.10, it supports @c which is a list containing the
cells of the actual row. You can query or modify elements of @c to
get or set cell properties like format, alignment, ...

You can find XLSPerl at L<http://perl.jonallen.info/projects/xlstools>

=head1 Author

Martin Fabiani L<http://www.fabiani.net/>

=cut


Datei ExcelPerl.pm:
Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
package ExcelPerl;
use warnings;
use strict;
use Carp qw(croak);

our $VERSION = 0.10;

# use Readonly; # better not, since Readonly is no standard module yet
use Win32::OLE;
use Win32::OLE::Const 'Microsoft Excel';
use Win32::OLE::Variant;
Win32::OLE->Option( Warn => 3);

use vars qw( @ObjInterfaceMethods @F );

# which object interface methods shell be available as standard
#Readonly::Array: Readonly is not yet a standard module :-(
@ObjInterfaceMethods =
    qw( excelFile excel workBook worksheet colSeparator
        worksheetNumber currentRow lastRow maxCol changeCount
       );

# install object interface methods at startup
foreach my $method ( @ObjInterfaceMethods ) {
    no strict 'refs'; # Sub::Install is no standard module :-(
    *{ $method } = sub {
        my( $self, @values ) = @_;
        $self->{ $method } = $values[0] if scalar @values;
        return $self->{ $method };
    };
} # foreach

# ============================================================
sub new {
    my( $class, %params ) = @_;

    my $self = bless {}, $class;
    foreach my $param (keys %params) {
        $self->$param( $params{$param} );
    } # foreach

    return $self;
} # new
# ------------------------------------------------------------
sub DESTROY {
#    my $self = shift;
} # DESTROY
# ------------------------------------------------------------
sub increaseCurrentRow {
    my $self = shift;
    $self->currentRow( 1 + $self->currentRow );
} # increaseCurrentRow
# ------------------------------------------------------------
sub increaseChangeCount {
    my $self = shift;
    no warnings;
    $self->changeCount( 1 + $self->changeCount );
} # increaseChangeCount
# ------------------------------------------------------------
sub open {
    my( $self ) = @_;

    my $filename = $self->excelFile;
    defined $filename or croak "Error: no filename given";
    -f $filename or croak( "Error: filename '$filename' doesn't exist");

    my $excel; # try to re-use running instance of Excel
    eval { $excel = Win32::OLE->GetActiveObject( 'Excel.Application' ) };
    die "Error: no Excel installed\n" if $@;

    unless( defined $excel ) { # if not running, start excel
        $excel = Win32::OLE->new( 'Excel.Application', sub { $_[0]->Quit } )
            or die "Error: can't start Excel\n";
    } # unless
    $self->excel( $excel );

    $self->workBook( $excel->Workbooks->Open( $filename ) );

    $self->worksheet( $self->workBook->Worksheets( $self->worksheetNumber ) );

    my $range = $self->worksheet->UsedRange->{Value};
    $self->lastRow( $#$range + 1 );
    $self->currentRow( 0 );

    return $self;
} # open
# ------------------------------------------------------------
sub getNextRow {
    my( $self, $F ) = @_;

    $self->increaseCurrentRow;

    my $row   = $self->currentRow;
    my $sheet = $self->worksheet;
    return if $row > $self->lastRow;

    # thanks to pKai for this idea:
    my $bottomRight =
        ( split( /:/, $self->worksheet->UsedRange->address(0,0)) )[-1];
    my( $colNameMax, $rowNumMax ) = $bottomRight =~ /^([A-Z]+)(\d+)$/;
    $self->lastRow( $rowNumMax  );
    $self->maxCol ( $colNameMax );
    my $rowData = $sheet->Range("A$row:" . $self->maxCol . $row)->{Value};

    # prepare ole objects for return representing array of cells
    my @cells = ();
    for my $cell ('A' .. $self->maxCol) {
        push( @cells, $sheet->Range("$cell$row") );
    } # for

    tie( @$F, 'ExcelPerl::RowArray', $self );

    foreach my $value ( ref $rowData ? @{ $rowData->[0] } : $rowData ) {
        push( @$F, $value );
    } # foreach

    return @cells;
} # getNextRow
# ------------------------------------------------------------

# ============================================================
package ExcelPerl::RowArray;
# ------------------------------------------------------------
use Tie::Array;
use vars qw( @ISA );
@ISA   = qw( Tie::Array );
# ------------------------------------------------------------
sub TIEARRAY {
    my( $class, $excelObj ) = @_;

    my $self = bless( { data => [] }, $class );
    $self->{excelObj} = $excelObj;
    $self->{row} = $excelObj->currentRow;

    return $self;
} # TIEARRAY
# ------------------------------------------------------------
sub FETCH {
    my( $self, $index) = @_;
    return $self->{data}->[ $index ];
} # FETCH
# ------------------------------------------------------------
sub STORE {
    my( $self, $index, $newValue ) = @_;

    my $excelObj = $self->{excelObj};
    my $sheet    = $excelObj->worksheet;

    my $row = $excelObj->currentRow;
    my $col = $index + 1;
    my $oldValue = $self->{data}->[$index];

    if( ( not defined $oldValue and defined $newValue ) or
        ( defined $oldValue and not defined $newValue ) or
        ( $oldValue ne $newValue )
   ) {
        $excelObj->increaseChangeCount;
        $sheet   ->Cells($row, $col)->{'Value' } = $newValue;
        $self    ->{'data'}         ->[ $index ] = $newValue;
    } # if
} # STORE
# ------------------------------------------------------------
sub FETCHSIZE {
    my $self = shift;
    return $#{ $self->{data} };
} # FETCHSIZE
# ------------------------------------------------------------
sub STORESIZE {
    my( $self, $newLength ) = @_;
    $#{ $self->{data} } = $newLength;
} # STORESIZE
# ------------------------------------------------------------
sub PUSH {
    my $self = shift;
    return push( @{ $self->{data} }, @_ );
} # PUSH
# ------------------------------------------------------------
sub CLEAR {
    my( $self ) = @_;
    my $data = $self->{data};
    for my $i (0..$#$data) {
        $self->STORE( $i, '' );
    } # for
} # CLEAR
# ------------------------------------------------------------
sub DESTROY {
#    my $self = shift;
} # DESTROY
# ------------------------------------------------------------
1; # modules have to return a true value


Viel Spass, und bitte um Kritik.
perl -le "s::*erlco'unaty.'.dk':e,y;*kn:ai;penmic;;print"
http://www.fabiani.net/
Strat
 2007-06-15 17:08
#38946 #38946
User since
2003-08-04
5246 Artikel
ModeratorIn
[Homepage] [default_avatar]
ExcelPerl V0.12 ist released und kann ueber http://www.fabiani.net/ -> Perl -> Downloads bezogen werden.

Neu: Die beiden Argumente -begin und -end, die jeweils Codeschnipsel angeben, die vor bzw. nach der while-schleife (-ane) ausgefuehrt werden. Dadurch sind jetzt auch Konstrukte wie z.B. die folgenden moeglich:

Code: (dl )
1
2
3
4
5
6
7
8
9
excelPerl.pl ^
    -ane "$x{$F[0]}++" ^
    -end "use Data::Dumper; print Dumper \%x" ^
    -f test.xls

excelPerl.pl ^
    -begin "use Text::CSV_XS; $csv = Text::CSV_XS->new( { binary => 1} )" ^
    -ane "$csv->combine(@F); print $csv->string, $/" ^
    -f file.xls
perl -le "s::*erlco'unaty.'.dk':e,y;*kn:ai;penmic;;print"
http://www.fabiani.net/
<< |< 1 2 >| >> 16 Einträge, 2 Seiten



View all threads created 2006-11-05 23:06.