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