File Coverage

blib/lib/Win32/Scsv.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             package Win32::Scsv;
2             $Win32::Scsv::VERSION = '0.37';
3 1     1   596 use strict;
  1         1  
  1         23  
4 1     1   3 use warnings;
  1         1  
  1         25  
5              
6 1     1   207 use Win32::OLE;
  0            
  0            
7             use Win32::OLE::Variant;
8             use Carp;
9             use File::Spec;
10             use File::Copy;
11             use File::Slurp;
12             use Win32::File qw();
13              
14             use Win32::OLE::Const;
15             my $Const_MSExcel;
16              
17             require Exporter;
18             our @ISA = qw(Exporter);
19             our @EXPORT = qw();
20             our @EXPORT_OK = qw(
21             xls_2_csv xls_all_csv csv_2_xls xls_2_vbs slurp_vbs import_vbs_book empty_xls
22             get_xver get_book get_last_row get_last_col tmp_book open_excel
23             get_lang XLRef XLConst ftranslate get_excel set_style_R1C1 restore_style
24             );
25              
26             sub XLConst {
27             $Const_MSExcel = Win32::OLE::Const->Load('Microsoft Excel') unless $Const_MSExcel;
28              
29             return $Const_MSExcel;
30             }
31              
32             my $CXL_OpenXML = 51; # xlOpenXMLWorkbook
33             my $CXL_Normal = -4143; # xlNormal
34             my $CXL_PasteVal = -4163; # xlPasteValues
35             my $CXL_PasteAll = -4104; # xlPasteAll
36             my $CXL_Csv = 6; # xlCSV
37             my $CXL_CalcMan = -4135; # xlCalculationManual
38             my $CXL_Previous = 2; # xlPrevious
39             my $CXL_ByRows = 1; # xlByRows
40             my $CXL_ByCols = 2; # xlByColumns
41             my $CXL_R1C1 = -4150; # xlR1C1
42             my $CXL_Part = 2; # xlPart
43              
44             my $vtfalse = Variant(VT_BOOL, 0);
45             my $vttrue = Variant(VT_BOOL, 1);
46              
47             my $ole_global;
48             my $excel_exe;
49             my $lang_global;
50             my $ref_style;
51             my $calc_manual = 0;
52             my $calc_befsave = 0;
53              
54             for my $office ('', '11', '12', '14', '15') {
55             for my $x86 ('', ' (x86)') {
56             my $Rn = 'C:\Program Files'.$x86.
57             '\Microsoft Office\OFFICE'.$office.'\EXCEL.EXE';
58              
59             $excel_exe = $Rn if -f $Rn;
60             }
61             }
62              
63             sub set_calc_manual { $calc_manual = $_[0] }
64             sub set_calc_befsave { $calc_befsave = $_[0] }
65              
66             sub open_excel {
67             unless (defined $excel_exe) {
68             croak "Can't find EXCEL.EXE";
69             }
70              
71             system qq{start /min cmd.exe /k ""$excel_exe" "$_[0]" || pause & exit"};
72             }
73              
74             # Comment by Klaus Eichner, 11-Feb-2012:
75             # **************************************
76             #
77             # I have copied the sample code from
78             # http://bytes.com/topic/perl/answers/770333-how-convert-csv-file-excel-file
79             #
80             # ...and from
81             # http://www.tek-tips.com/faqs.cfm?fid=6715
82             #
83             # ...also an excellent source of information with regards to Win32::Ole / Excel is the
84             # perlmonks-article ("Using Win32::OLE and Excel - Tips and Tricks") at the following site:
85             # http://www.perlmonks.org/bare/?node_id=153486
86             #
87             # ...In that perlmonks-article there is a link to another article
88             # ("The Perl Journal #10, courtesy of Jon Orwant")
89             # http://search.cpan.org/~gsar/libwin32-0.191/OLE/lib/Win32/OLE/TPJ.pod
90             #
91             # ...I found the following site to identify the different Excel versions (12.0 -> 2007, 11.0 -> 2003, etc...):
92             # http://www.mrexcel.com/forum/excel-questions/357733-visual-basic-applications-test-finding-excel-version.html
93             #
94             # ...I found the following blog ('robhammond.co') to extract Excel macros -- see below subroutine xls_2_vbs()...
95             # http://robhammond.co/blog/export-vba-code-from-excel-files-using-perl/
96             #
97             # ...in this blog ('robhammond.co'), the following 3 additional links were mentioned:
98             # http://www.perlmonks.org/?node_id=927532
99             # http://www.perlmonks.org/?node_id=953718
100             # http://access.mvps.org/access/general/gen0022.htm
101              
102             # Comment by Klaus Eichner, 12-Jan-2014:
103             # **************************************
104             #
105             # I have copied sample code for import_vbs_file() from
106             # http://www.mrexcel.com/articles/copy-vba-module.php
107              
108             sub get_xver {
109             my $ole_excel = get_excel() or croak "Can't start Excel";
110              
111             my $ver = $ole_excel->Version;
112             my $prd =
113             $ver eq '15.0' ? '2013' :
114             $ver eq '14.0' ? '2010' :
115             $ver eq '12.0' ? '2007' :
116             $ver eq '11.0' ? '2003' :
117             $ver eq '10.0' ? '2002' :
118             $ver eq '9.0' ? '2000' :
119             $ver eq '8.0' ? '1997' :
120             $ver eq '7.0' ? '1995' : '????';
121              
122             return ($ver, $prd) if wantarray;
123             return $ver;
124             }
125              
126             my %FDef = (
127             'SUM' => { DE => 'SUMME', FR => 'SOMME' },
128             'SUMIF' => { DE => 'SUMMEWENN', FR => 'SOMME.SI' },
129             );
130              
131             sub get_lang {
132             return $lang_global if defined $lang_global;
133              
134             my $ole_excel = get_excel() or croak "Can't start Excel";
135             my $book = $ole_excel->Workbooks->Add or croak "Can't Workbooks->Add";
136             my $sheet = $book->Worksheets(1) or croak "Can't find Sheet '1' in new Workbook";
137              
138             my $F_EN = 'SUM';
139             my $F_DE = $FDef{$F_EN}{'DE'} // croak "Can't find language equivalent in 'DE' for function '$F_EN'";
140             my $F_FR = $FDef{$F_EN}{'FR'} // croak "Can't find language equivalent in 'FR' for function '$F_EN'";
141              
142             $sheet->Cells(1, 1)->{'Formula'} = "=$F_EN(1)";
143             $sheet->Cells(1, 2)->{'Formula'} = "=$F_DE(1)";
144             $sheet->Cells(1, 3)->{'Formula'} = "=$F_FR(1)";
145              
146             my $lg =
147             $sheet->Cells(1, 1)->{'Value'} eq '1' ? 'EN' :
148             $sheet->Cells(1, 2)->{'Value'} eq '1' ? 'DE' :
149             $sheet->Cells(1, 3)->{'Value'} eq '1' ? 'FR' : croak "Can't decide language between ('$F_EN', '$F_DE' or '$F_FR')";
150              
151             $book->Close;
152              
153             $lang_global = $lg;
154              
155             return $lang_global;
156             }
157              
158             # Comment by Klaus Eichner, 02-Oct-2016:
159             # **************************************
160             #
161             # I have added 3 new functions set_style_R1C1(), restore_style() and ftranslate().
162             #
163             # Why, you might ask...
164             #
165             # ...because I had big problems with my German version of Excel crashing when using
166             # a non-trivial formula with Perl / Win32::OLE...
167             #
168             # ...it turned out that the default references (Style "A1")
169             # was too much to handle for my German Excel. In order for Excel not to crash,
170             # one better switches to the relative style ("R[-1]C[2]")
171             #
172             # Here is the StackOverflow article that got me on the right track:
173             #
174             # http://stackoverflow.com/questions/1674987/how-do-i-set-excel-formulas-with-win32ole#1675036
175             #
176             # >> Without the quotes I get an errormessage: Win32::OLE(0.1709) error 0x80020009:
177             # >> "Ausnahmefehler aufgetreten" in PROPERTYPUT "FormulaR1C1" at
178             # >> C:\Dokumente und Einstellungen\pp\Eigene Dateien\excel.pl line 113
179             # >> Just to check, you now have... $sheet->Range( 'G4' )->{FormulaR1C1} = '=SUMME(R[-3]C:R[-1]C)';
180             # >> @ Joel : Yes. Update: considering Joel's commend, neither of the two formula works.
181             # >> With the help of the perl-community.de I have now a solution: I have to set
182             # >> $excel->{ReferenceStyle} = $xl->{xlR1C1};
183             # >> and use Z1S1 instead of R1C1
184             # >> =SUMME(Z(-2)S:Z(-1)S)
185             # >> But it looks like that in the German version I have to choose between the A1 and the Z1S1 (R1C1) notation.
186             # >> Sounds like this was your problem all along - strange.
187             #
188             # ...as for the French version of Excel, the following sums it up quite nicely:
189             #
190             # http://www.office-archive.com/4-excel/0262612dc88a206e.htm
191             #
192             # >> all our french-VBA code was translated to english-VBA.
193             # >> If you really want to stick to L1C1 references, beware of:
194             # >> "[" and "]" => "(" and ")"
195             # >> ";" => ","
196             # >> and of course "L" => "R"
197              
198             sub set_style_R1C1 {
199             $ref_style = $ole_global->{ReferenceStyle};
200             $ole_global->{ReferenceStyle} = $CXL_R1C1;
201             }
202              
203             sub restore_style {
204             $ole_global->{ReferenceStyle} = $ref_style;
205             }
206              
207             sub ftranslate {
208             unless (defined $lang_global) {
209             croak "lang is not defined in get_frm";
210             }
211              
212             my @result;
213              
214             for (@_) {
215             my $t2;
216              
217             if (m{\A = (.*) \z}xms) {
218             my $func_gen = uc($1);
219              
220             if ($lang_global eq 'EN') {
221             $t2 = $func_gen;
222             }
223             else {
224             my $item = $FDef{$func_gen} // croak "Can't find function '$func_gen'";
225             $t2 = $item->{$lang_global} // croak "Can't find function '$func_gen', language '$lang_global'";
226             }
227             }
228             elsif (m{\A < ([^>]*) > \z}xms) {
229             my $adr_gen = uc($1);
230              
231             if ($lang_global eq 'EN') {
232             $t2 = $adr_gen;
233             }
234             elsif ($lang_global eq 'DE') {
235             $t2 = $adr_gen =~ s{R}'Z'xmsgr =~ s{C}'S'xmsgr =~ s{\[}'('xmsgr =~ s{\]}')'xmsgr;
236             }
237             elsif ($lang_global eq 'FR') {
238             $t2 = $adr_gen =~ s{R}'L'xmsgr =~ s{\[}'('xmsgr =~ s{\]}')'xmsgr;
239             }
240             else {
241             croak "Invalid language '$lang_global'";
242             }
243             }
244             elsif ($_ eq ',') {
245             if ($lang_global eq 'EN') {
246             $t2 = ',';
247             }
248             elsif ($lang_global eq 'DE') {
249             $t2 = ';';
250             }
251             elsif ($lang_global eq 'FR') {
252             $t2 = ';';
253             }
254             else {
255             croak "Invalid language '$lang_global'";
256             }
257             }
258             else {
259             croak "Can't parse parameter '$_'";
260             }
261              
262             push @result, $t2;
263             }
264              
265             return @result;
266             }
267              
268             sub xls_2_csv {
269             my ($xls_name, $xls_snumber) = $_[0] =~ m{\A ([^%]*) % ([^%]*) \z}xms ? ($1, $2) : ($_[0], 1);
270             my $csv_name = $_[1];
271             my @col_fmt = $_[2] && defined($_[2]{'fmt'}) ? @{$_[2]{'fmt'}} : ();
272             my $cpy_name = $_[2] && defined($_[2]{'cpy'}) ? lc($_[2]{'cpy'}) : 'val';
273             my $rem_crlf = $_[2] && defined($_[2]{'rmc'}) ? $_[2]{'rmc'} : 0;
274             my $set_calc = $_[2] && defined($_[2]{'clc'}) ? $_[2]{'clc'} : 0;
275              
276             my $C_Special =
277             $cpy_name eq 'val' ? $CXL_PasteVal :
278             $cpy_name eq 'all' ? $CXL_PasteAll :
279             croak "Invalid parameter cpy => ('$cpy_name'), expected ('val' or 'all')";
280              
281             unless ($xls_name =~ m{\A (.*) \. (xls x?) \z}xmsi) {
282             croak "xls_name '$xls_name' does not have an Excel extension (*.xls, *.xlsx)";
283             }
284              
285             my ($xls_stem, $xls_ext) = ($1, lc($2));
286              
287             unless (-f $xls_name) {
288             croak "xls_name '$xls_name' not found";
289             }
290              
291             my $xls_abs = File::Spec->rel2abs($xls_name); $xls_abs =~ s{/}'\\'xmsg;
292             my $csv_abs = File::Spec->rel2abs($csv_name); $csv_abs =~ s{/}'\\'xmsg;
293              
294             # remove the CSV file (if it exists)
295             if (-e $csv_abs) {
296             unlink $csv_abs or croak "Can't unlink csv_abs '$csv_abs' because $!";
297             }
298              
299             my $ole_excel = get_excel() or croak "Can't start Excel";
300              
301             my $xls_book = $ole_excel->Workbooks->Open($xls_abs)
302             or croak "Can't Workbooks->Open xls_abs '$xls_abs'";
303              
304             my $xls_sheet = $xls_book->Worksheets($xls_snumber)
305             or croak "Can't find Sheet '$xls_snumber' in xls_abs '$xls_abs'";
306              
307             $xls_sheet->{'Visible'} = $vttrue;
308              
309             if ($set_calc) {
310             $xls_sheet->Calculate;
311             }
312              
313             my $csv_book = $ole_excel->Workbooks->Add or croak "Can't Workbooks->Add";
314             my $csv_sheet = $csv_book->Worksheets(1) or croak "Can't find Sheet '1' in new Workbook";
315              
316             $xls_sheet->Cells->AutoFilter; # This should, I hope, get rid of any AutoFilter...
317             $xls_sheet->Cells->Copy;
318             $csv_sheet->Range('A1')->PasteSpecial($C_Special); # $CXL_PasteVal or $CXL_PasteAll
319              
320             if ($rem_crlf) {
321             # Cells.Replace What:="" & Chr(10) & "",
322             # Replacement:="~", LookAt:=xlPart, SearchOrder _
323             # :=xlByRows, MatchCase:=False
324             # *************************************************
325              
326             $csv_sheet->Cells->Replace({
327             What => "\x{09}", # Tab
328             Replacement => '~!',
329             LookAt => $CXL_Part,
330             SearchOrder => $CXL_ByRows,
331             MatchCase => $vtfalse,
332             });
333              
334             $csv_sheet->Cells->Replace({
335             What => "\x{0a}", # CR
336             Replacement => '~*',
337             LookAt => $CXL_Part,
338             SearchOrder => $CXL_ByRows,
339             MatchCase => $vtfalse,
340             });
341              
342             $csv_sheet->Cells->Replace({
343             What => "\x{0d}", # LF
344             Replacement => '~+',
345             LookAt => $CXL_Part,
346             SearchOrder => $CXL_ByRows,
347             MatchCase => $vtfalse,
348             });
349             }
350              
351             $csv_sheet->Activate;
352             $csv_sheet->Columns($_->[0])->{NumberFormat} = $_->[1] for @col_fmt;
353              
354             $csv_book->SaveAs($csv_abs, $CXL_Csv);
355              
356             $csv_book->Close;
357             $xls_book->Close;
358             }
359              
360             sub xls_all_csv {
361             my $xls_name = $_[0];
362             my $csv_name = $_[1];
363             my $cpy_name = $_[2] && defined($_[2]{'cpy'}) ? lc($_[2]{'cpy'}) : 'val';
364             my $rem_crlf = $_[2] && defined($_[2]{'rmc'}) ? $_[2]{'rmc'} : 0;
365             my $set_calc = $_[2] && defined($_[2]{'clc'}) ? $_[2]{'clc'} : 0;
366              
367             my $C_Special =
368             $cpy_name eq 'val' ? $CXL_PasteVal :
369             $cpy_name eq 'all' ? $CXL_PasteAll :
370             croak "Invalid parameter cpy => ('$cpy_name'), expected ('val' or 'all')";
371              
372             unless ($xls_name =~ m{\A (.*) \. (xls x?) \z}xmsi) {
373             croak "xls_name '$xls_name' does not have an Excel extension (*.xls, *.xlsx)";
374             }
375              
376             my ($xls_stem, $xls_ext) = ($1, lc($2));
377              
378             unless (-f $xls_name) {
379             croak "xls_name '$xls_name' not found";
380             }
381              
382             my $xls_abs = File::Spec->rel2abs($xls_name); $xls_abs =~ s{/}'\\'xmsg;
383             my $csv_abs = File::Spec->rel2abs($csv_name); $csv_abs =~ s{/}'\\'xmsg;
384              
385             my ($csv_dir, $csv_leaf) = $csv_abs =~ m{\A (.+) [\\/] ([^\\/]+) _ \* \. csv \z}xmsi ? ($1, $2) : croak "Can't parse (dir/_*.csv) from csv_abs = '$csv_abs'";
386              
387             # remove all existing *.CSV files
388              
389             for (sort(read_dir($csv_dir))) {
390             my $cfull = $csv_dir.'\\'.$_;
391              
392             next unless -f $cfull;
393             next unless m{\A \Q$csv_leaf\E _ \d+ \. csv \z}xmsi;
394              
395             unlink $cfull or croak "Can't unlink csv_leaf '$cfull' because $!";
396             }
397              
398             my $tfull = $csv_dir.'\\'.$csv_leaf.'_'.sprintf('%03d', 0).'.csv';
399              
400             open my $ofh, '>', $tfull or croak "Can't open > '$tfull' because $!";
401              
402             say {$ofh} 'SNo;Sheet';
403              
404             my $ole_excel = get_excel() or croak "Can't start Excel";
405              
406             my $xls_book = $ole_excel->Workbooks->Open($xls_abs)
407             or croak "Can't Workbooks->Open xls_abs '$xls_abs'";
408              
409             for my $xls_snumber (1..$xls_book->Sheets->Count) {
410             my $xls_sheet = $xls_book->Worksheets($xls_snumber)
411             or croak "Can't find Sheet '$xls_snumber' in xls_abs '$xls_abs'";
412              
413             my $sfull = $csv_dir.'\\'.$csv_leaf.'_'.sprintf('%03d', $xls_snumber).'.csv';
414              
415             printf {$ofh} "S%03d;[%s]\n", $xls_snumber, $xls_sheet->Name;
416              
417             my $csv_book = $ole_excel->Workbooks->Add or croak "Can't Workbooks->Add";
418             my $csv_sheet = $csv_book->Worksheets(1) or croak "Can't find Sheet '1' in new Workbook";
419              
420             $xls_sheet->{'Visible'} = $vttrue;
421              
422             if ($set_calc) {
423             $xls_sheet->Calculate;
424             }
425              
426             $xls_sheet->Cells->AutoFilter; # This should, I hope, get rid of any AutoFilter...
427             $xls_sheet->Cells->Copy;
428              
429             $csv_sheet->Range('A1')->PasteSpecial($C_Special); # $CXL_PasteVal or $CXL_PasteAll
430              
431             if ($rem_crlf) {
432             # Cells.Replace What:="" & Chr(10) & "",
433             # Replacement:="~", LookAt:=xlPart, SearchOrder _
434             # :=xlByRows, MatchCase:=False
435             # *************************************************
436              
437             $csv_sheet->Cells->Replace({
438             What => "\x{09}", # Tab
439             Replacement => '~!',
440             LookAt => $CXL_Part,
441             SearchOrder => $CXL_ByRows,
442             MatchCase => $vtfalse,
443             });
444              
445             $csv_sheet->Cells->Replace({
446             What => "\x{0a}", # CR
447             Replacement => '~*',
448             LookAt => $CXL_Part,
449             SearchOrder => $CXL_ByRows,
450             MatchCase => $vtfalse,
451             });
452              
453             $csv_sheet->Cells->Replace({
454             What => "\x{0d}", # LF
455             Replacement => '~+',
456             LookAt => $CXL_Part,
457             SearchOrder => $CXL_ByRows,
458             MatchCase => $vtfalse,
459             });
460             }
461              
462             $csv_book->SaveAs($sfull, $CXL_Csv);
463              
464             $csv_book->Close;
465             }
466              
467             $xls_book->Close;
468             close $ofh;
469             }
470              
471             sub csv_2_xls {
472             my ($xls_name, $xls_snumber) = $_[1] =~ m{\A ([^%]*) % ([^%]*) \z}xms ? ($1, $2) : ($_[1], 1);
473             my $csv_name = $_[0];
474              
475             my $tpl_name = $_[2] && defined($_[2]{'tpl'}) ? $_[2]{'tpl'} : '';
476             my @col_size = $_[2] && defined($_[2]{'csz'}) ? @{$_[2]{'csz'}} : ();
477             my @col_fmt = $_[2] && defined($_[2]{'fmt'}) ? @{$_[2]{'fmt'}} : ();
478             my $sheet_prot = $_[2] && defined($_[2]{'prot'}) ? $_[2]{'prot'} : 0;
479              
480             my $init_new = 0;
481              
482             if ($tpl_name eq '*') {
483             $init_new = 1;
484             $tpl_name = '';
485             }
486              
487             my ($xls_stem, $xls_ext) = $xls_name =~ m{\A (.*) \. (xls x?) \z}xmsi ? ($1, lc($2)) :
488             croak "xls_name '$xls_name' does not have an Excel extension of the right type (*.xls, *.xlsx)";
489              
490             my $xls_format = $xls_ext eq 'xls' ? $CXL_Normal : $CXL_OpenXML;
491              
492             my ($tpl_stem, $tpl_ext) =
493             $tpl_name eq '' ? ('', '') :
494             $tpl_name =~ m{\A (.*) \. (xls x?) \z}xmsi ? ($1, lc($2)) :
495             croak "tpl_name '$tpl_name' does not have an Excel extension of the right type (*.xls, *.xlsx)";
496              
497             unless ($tpl_name eq '' or $tpl_ext eq $xls_ext) {
498             croak "extensions do not match between ".
499             "xls and tpl ('$xls_ext', '$tpl_ext'), name is ('$xls_name', '$tpl_name')";
500             }
501              
502             my $xls_abs = $xls_name eq '' ? '' : File::Spec->rel2abs($xls_name); $xls_abs =~ s{/}'\\'xmsg;
503             my $tpl_abs = $tpl_name eq '' ? '' : File::Spec->rel2abs($tpl_name); $tpl_abs =~ s{/}'\\'xmsg;
504             my $csv_abs = $csv_name eq '' ? '' : File::Spec->rel2abs($csv_name); $csv_abs =~ s{/}'\\'xmsg;
505              
506             if ($init_new) {
507             if (-e $xls_abs) {
508             unlink $xls_abs or croak "Can't unlink '$xls_abs' because $!";
509             }
510              
511             my $tmp_ole = get_excel() or croak "Can't start Excel (tmp)";
512             my $tmp_book = $tmp_ole->Workbooks->Add or croak "Can't Workbooks->Add xls_abs '$xls_abs' (tmp)";
513             $tmp_book->SaveAs($xls_abs, $xls_format);
514             $tmp_book->Close;
515             }
516              
517             if ($tpl_name eq '') {
518             unless (-f $xls_name) {
519             croak "xls_name ('$xls_name') does not exist and template was not specified";
520             }
521             }
522             else {
523             unlink $xls_name;
524             copy $tpl_name, $xls_name
525             or croak "Can't copy tpl_name to xls_name ('$tpl_name', '$xls_name') because $!";
526             }
527              
528             unless ($csv_abs eq '' or -f $csv_abs) {
529             croak "csv_abs '$csv_abs' not found";
530             }
531              
532             unless ($tpl_abs eq '' or -f $tpl_abs) {
533             croak "tpl_abs '$tpl_abs' not found";
534             }
535              
536             # Force "$xls_abs" to be RW -- i.e. remove the RO flag, if any...
537             # ***************************************************************
538              
539             {
540             my $aflag;
541              
542             unless (Win32::File::GetAttributes($xls_abs, $aflag)) {
543             croak "Can't get attributes from '$xls_abs'";
544             }
545              
546             if ($aflag & Win32::File::READONLY()) {
547             unless (Win32::File::SetAttributes($xls_abs, ($aflag & ~Win32::File::READONLY()))) {
548             croak "Can't set attribute ('RW') for '$xls_abs'";
549             }
550             }
551             }
552              
553             my $ole_excel = get_excel() or croak "Can't start Excel (new)";
554             my $xls_book = $ole_excel->Workbooks->Open($xls_abs) or croak "Can't Workbooks->Open xls_abs '$xls_abs'";
555             my $xls_sheet = $xls_book->Worksheets($xls_snumber) or croak "Can't find Sheet '$xls_snumber' in xls_abs '$xls_abs'";
556              
557             $xls_sheet->Activate; # "...->Activate" is necessary in order to allow "...Range('A1')->Select" later to be effective
558             $xls_sheet->Unprotect; # unprotect the sheet in any case...
559             $xls_sheet->Columns($_->[0])->{NumberFormat} = $_->[1] for @col_fmt;
560              
561             unless ($csv_abs eq '') {
562             my $csv_book = $ole_excel->Workbooks->Open($csv_abs) or croak "Can't Workbooks->Open csv_abs '$csv_abs'";
563             my $csv_sheet = $csv_book->Worksheets(1) or croak "Can't find Sheet #1 in csv_abs '$csv_abs'";
564              
565             $xls_sheet->Cells->ClearContents;
566             $csv_sheet->Cells->Copy;
567             $xls_sheet->Range('A1')->PasteSpecial($CXL_PasteVal);
568             $xls_sheet->Cells->EntireColumn->AutoFit;
569              
570             $csv_book->Close;
571             }
572              
573             $xls_sheet->Columns($_->[0])->{ColumnWidth} = $_->[1] for @col_size;
574              
575             #~ http://www.mrexcel.com/forum/excel-questions/275645-identifying-freeze-panes-position-sheet-using-visual-basic-applications.html
576             #~ The command "$ole_excel->ActiveWindow->Panes($pi)->VisibleRange->Address" has currently no use,
577             #~ but you never know what it might be good for in the future...
578             #~
579             #~ Deb-0010: PCount = 4
580             #~ Deb-0020: Pane 1 = '$A$1:$E$1'
581             #~ Deb-0020: Pane 2 = '$F$1:$AA$1'
582             #~ Deb-0020: Pane 3 = '$A$45:$E$102'
583             #~ Deb-0020: Pane 4 = '$F$45:$AA$102'
584             #~
585             #~ print "Deb-0010: PCount = ", $ole_excel->ActiveWindow->Panes->Count, "\n";
586             #~ for my $pi (1..$ole_excel->ActiveWindow->Panes->Count) {
587             #~ print "Deb-0020: Pane $pi = '", $ole_excel->ActiveWindow->Panes($pi)->VisibleRange->Address, "'\n";
588             #~ }
589             #~
590             #~ However, "FreezePanes", "ScrollRow", "ScrollColumn" and "VisibleRange" are more useful...
591             #~
592             #~ print "Deb-0030: FreezePanes = '", $ole_excel->ActiveWindow->FreezePanes, "'\n";
593             #~ print "Deb-0040: ScrollRow = '", $ole_excel->ActiveWindow->ScrollRow, "'\n";
594             #~ print "Deb-0050: ScrollColumn = '", $ole_excel->ActiveWindow->ScrollColumn, "'\n";
595             #~ print "Deb-0060: VisibleRange = '", $ole_excel->ActiveWindow->VisibleRange, "'\n";
596             #~ print "Deb-0070: VisibleRange-Row = '", $ole_excel->ActiveWindow->VisibleRange->Row, "'\n";
597             #~ print "Deb-0070: VisibleRange-Col = '", $ole_excel->ActiveWindow->VisibleRange->Column, "'\n";
598             #~
599             #~ $ole_excel->ActiveWindow->VisibleRange->Select;
600              
601             #~ http://stackoverflow.com/questions/3232920/how-can-i-programmatically-freeze-the-top-row-of-an-excel-worksheet-in-excel-200
602             #~ Dim r As Range
603             #~ Set r = ActiveCell
604             #~ Range("A2").Select
605             #~ With ActiveWindow
606             #~ .FreezePanes = False
607             #~ .ScrollRow = 1
608             #~ .ScrollColumn = 1
609             #~ .FreezePanes = True
610             #~ .ScrollRow = r.Row
611             #~ End With
612             #~ r.Select
613              
614             # Be aware: Even if we try to set ActiveWindow->{ScrollColumn}/{ScrollRow} to "1", this might not succeed,
615             # because of frozen panes in the active window. As a consequence, ActiveWindow->{ScrollColumn}/{ScrollRow}
616             # could in fact be a value that differs from the original value "1". (this is reflected in the two variables
617             # $pos_row/$pos_col).
618              
619             $ole_excel->ActiveWindow->{ScrollColumn} = 1;
620             $ole_excel->ActiveWindow->{ScrollRow} = 1;
621              
622             my $pos_row = $ole_excel->ActiveWindow->{ScrollRow};
623             my $pos_col = $ole_excel->ActiveWindow->{ScrollColumn};
624              
625             $xls_sheet->Cells($pos_row, $pos_col)->Select;
626              
627             if ($sheet_prot) {
628             $xls_sheet->Protect({
629             DrawingObjects => $vttrue,
630             Contents => $vttrue,
631             Scenarios => $vttrue,
632             });
633             }
634              
635             $xls_book->SaveAs($xls_abs, $xls_format); # ...always use SaveAs(), never use Save() here ...
636             $xls_book->Close;
637             }
638              
639             sub xls_2_vbs {
640             my ($xls_name, $vbs_name) = @_;
641              
642             my $list = slurp_vbs($xls_name);
643              
644             open my $ofh, '>', $vbs_name or croak "Can't write to '$vbs_name' because $!";
645              
646             for my $l (@$list) {
647             print {$ofh} "' **>> ", '=' x 50, "\n";
648             print {$ofh} "' **>> ", 'Module: ', $l->{'NAME'}, "\n";
649             print {$ofh} "' **>> ", '=' x 50, "\n";
650             print {$ofh} $l->{'CODE'}, "\n";
651             print {$ofh} "' **>> ", '-' x 50, "\n";
652             }
653              
654             close $ofh;
655             }
656              
657             sub slurp_vbs {
658             my ($xls_name) = @_;
659              
660             my $xls_book = get_book($xls_name);
661              
662             my $xls_proj = $xls_book->{VBProject} or croak "Can't create object 'VBProject'";
663             my $xls_vbcomp = $xls_proj->{VBComponents} or croak "Can't create object 'VBComponents'";
664              
665             my $mlist = [];
666              
667             for my $xls_cele (in $xls_vbcomp) {
668             my $modname = $xls_cele->Name // '?';
669             my $xls_vb = $xls_cele->{CodeModule}
670             or croak "Can't create object 'CodeModule' for modname '$modname'";
671              
672             my $lcount = $xls_vb->{CountOfLines};
673              
674             if ($lcount) {
675             my $body = join '', $xls_vb->Lines(1, $lcount);
676             $body =~ s{\r}''xmsg; # fix superfluous linefeeds
677             push @$mlist, { 'NAME' => $modname, 'CODE' => $body };
678             }
679             }
680              
681             $xls_book->Close;
682              
683             return $mlist;
684             }
685              
686             sub import_vbs_book {
687             my ($xls_book, $vbs_name) = @_;
688              
689             my $vbs_abs = File::Spec->rel2abs($vbs_name); $vbs_abs =~ s{/}'\\'xmsg;
690              
691             my $xls_proj = $xls_book->{VBProject} or croak "Can't create object 'VBProject'";
692             my $xls_vbcomp = $xls_proj->{VBComponents} or croak "Can't create object 'VBComponents'";
693              
694             $xls_vbcomp->Import($vbs_abs);
695             }
696              
697             sub empty_xls {
698             my $xls_name = $_[0];
699              
700             my ($xls_stem, $xls_ext) = $xls_name =~ m{\A (.*) \. (xls x?) \z}xmsi ? ($1, lc($2)) :
701             croak "xls_name '$xls_name' does not have an Excel extension (*.xls, *.xlsx)";
702              
703             my $xls_format = $xls_ext eq 'xls' ? $CXL_Normal : $CXL_OpenXML;
704              
705             my $xls_abs = File::Spec->rel2abs($xls_name); $xls_abs =~ s{/}'\\'xmsg;
706              
707             my $ole_excel = get_excel() or croak "Can't start Excel";
708             my $xls_book = $ole_excel->Workbooks->Add or croak "Can't Workbooks->Add xls_abs '$xls_abs'";
709             my $xls_sheet = $xls_book->Worksheets(1) or croak "Can't find Sheet '1' in xls_abs '$xls_abs'";
710              
711             $xls_book->SaveAs($xls_abs, $xls_format);
712             $xls_book->Close;
713             }
714              
715             sub tmp_book {
716             my $ole_excel = get_excel() or croak "Can't start Excel";
717             my $xls_book = $ole_excel->Workbooks->Add or croak "Can't Workbooks->Add";
718              
719             return $xls_book;
720             }
721              
722             sub get_excel {
723             return $ole_global if $ole_global;
724              
725             # use existing instance if Excel is already running
726             my $ol1 = eval { Win32::OLE->GetActiveObject('Excel.Application') };
727             return if $@;
728              
729             unless (defined $ol1) {
730             $ol1 = Win32::OLE->new('Excel.Application', sub {$_[0]->Quit;})
731             or return;
732             }
733              
734             $ole_global = $ol1;
735             $ole_global->{DisplayAlerts} = 0;
736              
737             # http://www.decisionmodels.com/calcsecretsh.htm
738             # ----------------------------------------------
739             #
740             # If you need to override the way Excel initially sets the calculation mode you can set it yourself
741             # by creating a module in ThisWorkbook (doubleclick ThisWorkbook in the Project Explorer window in
742             # the VBE), and adding this code. This example sets calculation to Manual.
743             #
744             # Private Sub Workbook_Open()
745             # Application.Calculation = xlCalculationManual
746             # End Sub
747             #
748             # Unfortunately if calculation is set to Automatic when a workbook containing this code is opened,
749             # Excel will start the recalculation process before the Open event is executed. The only way I
750             # know of to avoid this is to open a dummy workbook with a Workbook open event which sets
751             # calculation to manual and then opens the real workbook.
752              
753             $ole_global->{Calculation} = $CXL_CalcMan if $calc_manual;
754             $ole_global->{CalculateBeforeSave} = $vtfalse if $calc_befsave;
755              
756             return $ole_global;
757             }
758              
759             sub get_book {
760             my ($prm_book_name) = @_;
761              
762             unless ($prm_book_name =~ m{\. xls x? \z}xmsi) {
763             croak "xls_name '$prm_book_name' does not have an Excel extension (*.xls, *.xlsx)";
764             }
765              
766             unless (-f $prm_book_name) {
767             croak "xls_name '$prm_book_name' not found";
768             }
769              
770             my $prm_book_abs = File::Spec->rel2abs($prm_book_name); $prm_book_abs =~ s{/}'\\'xmsg;
771              
772             my $obj_excel = get_excel() or croak "Can't start Excel";
773             my $obj_book = $obj_excel->Workbooks->Open($prm_book_abs) or croak "Can't Workbooks->Open xls_abs '$prm_book_abs'";
774              
775             return $obj_book;
776             }
777              
778             sub get_last_row {
779             my $proxy = $_[0]->UsedRange->Find({
780             What => '*',
781             SearchDirection => $CXL_Previous,
782             SearchOrder => $CXL_ByRows,
783             });
784              
785             $proxy ? $proxy->{'Row'} : 0;
786             }
787              
788             sub get_last_col {
789             my $proxy = $_[0]->UsedRange->Find({
790             What => '*',
791             SearchDirection => $CXL_Previous,
792             SearchOrder => $CXL_ByCols,
793             });
794              
795             $proxy ? $proxy->{'Column'} : 0;
796             }
797              
798             sub XLRef {
799             my ($col, $row) = @_;
800             $row //= '';
801              
802             my $c3 = int(($col - 1 - 26) / (26 * 26)); my $rem = $col - $c3 * 26 * 26;
803             my $c2 = int(($rem - 1) / 26);
804             my $c1 = $rem - $c2 * 26;
805              
806             return ($c3 == 0 ? '' : chr($c3 + 64)).($c2 == 0 ? '' : chr($c2 + 64)).chr($c1 + 64).$row;
807             }
808              
809             1;
810              
811             __END__