#!/Perl/bin/perl
use strict;
use warnings;
use DBI;
use Win32::OLE;
use Win32::OLE::Const;
use constant {TRUE => -1,
FALSE => 0};
#Hash that defines the months ending days
my %monthEnd = ('January' => '-01-31 23:59:59',
'February' => '-02-28 23:59:59',
'February_leap'=> '-02-29 23:59:59',
'March' => '-03-31 23:59:59',
'April' => '-04-30 23:59:59',
'May' => '-05-31 23:59:59',
'June' => '-06-30 23:59:59',
'July' => '-07-31 23:59:59',
'August' => '-08-31 23:59:59',
'September' => '-09-30 23:59:59',
'October' => '-10-31 23:59:59',
'November' => '-11-30 23:59:59',
'December' => '-12-31 23:59:59');
#Hash that defines the months starting days
my %monthStart = ('January' => '-01-01 00:00:00',
'February' => '-02-01 00:00:00',
+
'March' => '-03-01 00:00:00',
'April' => '-04-01 00:00:00',
'May' => '-05-01 00:00:00',
'June' => '-06-01 00:00:00',
'July' => '-07-01 00:00:00',
'August' => '-08-01 00:00:00',
'September' => '-09-01 00:00:00',
'October' => '-10-01 00:00:00',
'November' => '-11-01 00:00:00',
'December' => '-12-01 00:00:00');
#Array that defines the order of months
my @months = qw(January
February
March
April
May
June
July
August
September
October
November
December);
my $client = 'x';
my $year = '2002';
#Create default loop counter
my $i = 0;
my $dbh = DBI->connect('DBI:ODBC:x,'x','x');
##Create an Excel Application object
my $xl = Win32::OLE->new('Excel.Application');
$xl->{DisplayAlerts} = FALSE;
##Load a hash reference to Excel's constants in the scalar ref $xlCons
+t
my $xlConst = Win32::OLE::Const->Load('Microsoft Excel 8.0 Object Libr
+ary');
#Create a new workbook
my $book = $xl->Workbooks->Add();
##Renames Sheet1 to Production-XXX
renameSheet($book,'Sheet1',"Production-".$client);
##Delete Sheets 2 and 3
deleteSheets($book,['Sheet2','Sheet3']);
##Get a reference to the current_sheet being worked on
my $sheet = $book->Worksheets("Production-".$client);
#Create and initialize loop variables
my ($sth,$start,$end) = ('','','');
##Main Work Loop##
for('C','D','E','F','H','I')
{
#Grab query and use appropriate number formatting for the column
COLUMN:
{
##Invoices
$_ eq 'C' and do{$sth = $dbh->prepare(invoiceAmounts());
+
for my $j(0..13)
{
$sheet->Range($_.($j+5))->{NumberFormat}
+= "\$#,0.00";
}
print "Processing Monthly
last COLUMN;};
##Created
$_ eq 'D' and do{$sth = $dbh->prepare(Created());
+
for my $j(0..13)
{
$sheet->Range($_.($j+5))->{NumberFormat}
+= "#,0";
}
print
last COLUMN;};
##Blocked
$_ eq 'E' and do{$sth = $dbh->prepare(membersBlocked());
for my $j(0..13)
{
$sheet->Range($_.($j+5))->{NumberFormat} =
+ "#,0";
}
print
last COLUMN;};
##Killed
$_ eq 'F' and do{$sth = $dbh->prepare(membersKilled());
+
for my $j(0..13)
{
$sheet->Range($_.($j+5))->{NumberFormat} =
+ "#,0";
}
print "Processing
last COLUMN};
##Investigated
$_ eq 'H' and do{$sth = $dbh->prepare(membersInvestigated());
+
for my $j(0..13)
{
$sheet->Range($_.($j+5))->{NumberFormat}
+= "#,0";
}
print
last COLUMN};
##Invoiced
$_ eq 'I' and do{$sth = $dbh->prepare(membersInvoiced());
for my $j(0..13)
{
$sheet->Range($_.($j+5))->{NumberFormat}
+= "#,0";
}
print
last COLUMN};
}
#For each month in the year
foreach $i (0..scalar(@months)-1)
{
#Construct the start and end dates
$start = $year.$monthStart{$months[$i]};
$end = $year.$monthEnd{$months[$i]};
#Check for leap years
if($months[$i] eq 'February')
{
$end = $year.$monthEnd{'February_leap'} if !($year % 4);
}
#Call execute() with the appropriate placeholders
PARAMS:
{
##Created,Invoiced,Invoice Amount
($_ eq 'C' ||
$_ eq 'D' ||
$_ eq 'I') and do{$sth->execute($client,$start,$end);
+
last PARAMS;};
##Blocked
$_ eq 'E' and do{$sth->execute('Blocked',$client,$star
+t,$end);
last PARAMS;};
##Killed
$_ eq 'F' and do{$sth->execute('Killed',$client,$start
+,$end);
last PARAMS};
##Investigated
$_ eq 'H' and do{$sth->execute($client,$start,$end,'mm
+');
last PARAMS};
}
#Retrieve the value
my $count = $sth->fetchrow_arrayref;
#Add the value to the worksheet
$sheet->Range($_.($i+5))->{Value} = $$count[0];
}
}
#Precautionary finish call
$sth->finish();
#Disconnect from the database
$dbh->disconnect();
#Reset the counter
$i = 0;
#Create the headings and borders
for ('A'..'J')
{
#Write the heading
$sheet->Range($_."4")->{Value} = $headings[$i];
#Bold the heading
$sheet->Range($_."4")->Font->{Bold} = TRUE;
#Color the heading
$sheet->Range($_."4")->Interior->{ColorIndex} = 20;
#Align the cells to the center
$sheet->Range($_."4:".$_."16")->{HorizontalAlignment} = $$xlConst{
+'xlHAlignCenter'};
#Border the cells
for my $j(4..16)
{
$sheet->Range($_.$j)->BorderAround($$xlConst{'xlBorderLineStyl
+eContinuous'},
$$xlConst{'xlThin'}
+,
1);
}
$i++;
}
#Sum the columns where appropriate
for ('C'..'J')
{
#Sum the column
if($_ ne 'J')
{
$sheet->Range($_."17")->{Value} = "=SUM(".$_."5:".$_."16)";
}
#Average
$sheet->Range($_."18")->{Value} = "=SUM(".$_."5:".$_."16)/12";
#Bold the figure
$sheet->Range($_."17:".$_."18")->Font->{Bold} = TRUE;
}
#Label the months,potential, and invoice rate in the sheet
for (0..11)
{
#Month label
$sheet->Range("A".($_+5))->{Value} = $months[$_];
#Potential Audits
$sheet->Range("G".($_+5))->{Value} = "=D".($_+5)."-E".($_+5)."-F".
+($_+5);
#Invoice Rate
$sheet->Range("J".($_+5))->{Value} = "=H".($_+5)."/I".($_+5);
}
#Format the numbers
for (0..13)
{
$sheet->Range("J".($_+5))->{NumberFormat} = "#,0.00";
}
#Set the font size
$sheet->Range("A1:J18")->Font->{Size} = 9;
#Center the sheet
$sheet->Range("A1:J18")->{HorizontalAlignment} = $$xlConst{'xlHAlignCe
+nter'};
#Label Averages and Totals
$sheet->Range("A17")->{Value} = "Sums";
$sheet->Range("A18")->{Value} = "Averages";
#Put the values in
$sheet->Range("A1")->{Value} = "Performance:";
$sheet->Range("C1")->{Value} = $client;
#Format the fonts
$sheet->Range("A1")->Font->{Bold} = TRUE;
$sheet->Range("A17:A18")->Font->{Bold} = TRUE;
$sheet->Range("C1")->Font->{Italic} = TRUE;
#Merge A1 & B1
$sheet->Range("A1:B1")->{MergeCells} = TRUE;
#Create an embedded chart object
my $chart = $sheet->ChartObjects->Add(72,250,400,213);
#Set the Chart Type
$chart->Chart->{ChartType} = $$xlConst{'xlLine'};
#Create the series
$chart->Chart->SeriesCollection->Add($sheet->Range($_."4:".$_."16"),
$$xlConst{'xlColumns'},
TRUE) for('D'..'I');
#Autofit the cells by column
$sheet->Columns->AutoFit();
#Orient the page to landscape for printing
$sheet->PageSetup->{Orientation} = $$xlConst{'xlLandscape'};
#Save the sheet
$book->SaveAs("test.xls");
#Close the Application object
$xl->quit();
#Sub to rename an xl sheet given the
#Workbook object, the old name, the new name
sub renameSheet
{
my ($book,$old,$new) = @_;
$book->Worksheets($old)->{Name} = $new;
return;
}
sub deleteSheets
{
my ($book,$sheets) = @_;
DELETE_SHEET:
{
$sheets =~ m/SCALAR/ and do{$book->Worksheets($$sheets )->Dele
+te();
last DELETE_SHEET;};
$sheets =~ m/ARRAY/ and do{$book->Worksheets($_)->Delete() fo
+r @{$sheets};
last DELETE_SHEET;};
warn "**syntax error from sub deleteSheet(\$workbook,\$sheet|\
+@sheets)**\n";
warn "deleteSheet needs a scalar or array ref\n";
}
+
return;
}
This script runs some queries against a SQL Server Database to create the report that is then created and formatted via
. This is really more than you need, but its an example of a report that uses a decent amount of features and gives you an idea of what kind of code is needed to properly format something. Writing your own is more rewarding than gutting this one and making it fit your needs, so please do so if you find this one useful.