---Soumis par Dev Ashish---
Simuler VBA code en Perl utilisant OLE
Comment simuler du code VBA en Perl de par OLE
Ceci n'est pas une question fréquemment posée, mais j'ai décidé de l'ajouter ici puisque je n'ai rien vu d'équivalent ailleurs. Le code me fut posté par Norris Couch. Le contenu du message suit:
J'ai trouvé comment simuler le code VBA en Perl, utilisant OLE. Voici 500 lignes de code Perl. Ce code est unique à ma base de données et à mes besoins, mais l'idée peut être utilisée par tout le monde. Jan Dubois en Allemagne me fut d'un grad recours en m'assistant avec WIN32 OLE sous Perl.
'***************** Code Start *************** 'This code was originally written by Norris Couch.. 'It is not to be altered or distributed, 'except as part of an application. 'You are free to use it in any application, 'provided the copyright notice is left unchanged. ' 'Code courtesy of 'Norris Couch. #!perl -w # Move the Access results to Excel for further processing # # Call as: # # MONTHXLS # use strict; use Cwd; use Win32::OLE qw(in with); use Win32::OLE::Variant; use Win32::OLE::Const 'Microsoft Excel'; $Win32::OLE::Warn = 2; # Always warn with verbose error messages use constant TRUE => 1; use constant FALSE => 0; # Debugging variable use constant clDEBUG => FALSE; # True to see debug output $= = 9999 if (clDEBUG); # set the page length to 9999 lines # Global Variables my $loAccess; # Access Object my $loExcel; # Excel Object my $loDatabase; # Database Object my $loXlw; # Workbook Object my $loXls; # Spreadsheet Object my $loRS; # Recordset Object my $lcSQL; # SQL Query string my $lcSaveDir; # Default Access Directory string # Global Output field names my ($lclabel, $lncount, $lnpercent, $lnnsi, $lcci); # Global Row/Column Positioning names my ($lnRow, $lnCol); # Use existing instance if Access is already running or start Access eval {$loAccess = Win32::OLE->GetActiveObject('Access.Application')}; die "Access not installed" if $@; unless (defined $loAccess) { $loAccess = Win32::OLE->new('Access.Application','Quit') or die "Unable to start Access"; } # This database contains some queries that consolidate other databases and # address those databases ..\path\database. In order for these to run under # OLE, the GLOBAL! Access default database directory must be updated. This # saves the current value and later restores it BUT IF THIS PROGRAM DOES NOT # GET TO THE RESTORE CODE the default will continue to point to this # directory! $lcSaveDir = $loAccess->GetOption('Default Database Directory'); $loAccess->SetOption("Default Database Directory", cwd()); # Open the monthly database in the current directory $loDatabase = $loAccess->DBEngine->OpenDatabase('rs6kcpc.mdb'); if (Win32::OLE->LastError) { print "Unable to Open Access Database, LastError returned ", Win32::OLE->LastError, "\n"; } # Use existing instance if Excel is already running or start Excel eval {$loExcel = Win32::OLE->GetActiveObject('Excel.Application')}; die "Excel not installed" if $@; unless (defined $loExcel) { $loExcel = Win32::OLE->new('Excel.Application.8','Quit') or die "Unable to start Excel"; } # Set up Excel workbook with only one worksheet $loXlw = $loExcel->Workbooks->Add(xlWBATWorksheet) or die "Unable to create a new Excel workbook\n"; # Process Overall NSI Query $loRS = $loDatabase->OpenRecordset('RS6KCPC Overall NSI'); if (Win32::OLE->LastError) { print "Unable to Open RS6KCPC Overall NSI, LastError returned ", Win32::OLE->LastError, "\n"; } $loXls = $loXlw->ActiveSheet; # set Worksheet Object $loXls->{Name} = "Overall"; # Name the Worksheet $loRS->MoveFirst(); $lclabel = ''; $lncount = ''; $lnpercent = ''; $loXls->Range("C1")->{Value} = $lnnsi = $loRS->Fields('NSI')->Value; with($loXls->Columns(3), NumberFormat => '#0.0', HorizontalAlignment => xlRight); $loXls->Range("D1")->{Value} = $lcci = $loRS->Fields('95% CI')->Value; with($loXls->Columns(4), HorizontalAlignment => xlRight); $loXls->Range("C:D")->Columns->AutoFit; write if (clDEBUG); print "\n" if (clDEBUG); # Process NSI by Channel Common_Query('Channel','RS6KCPC NSI by Channel'); # Process NSI by Usage Common_Query('Usage', 'RS6KCPC NSI by Usage'); # Process NSI by Primary Usage Common_Query('PrimeUse', 'RS6KCPC NSI by Primary Usage'); # Process NSI by Source Common_Query('Source', 'RS6KCPC NSI by Source'); # Process NSI by BMT Common_Query('BMT', 'RS6KCPC NSI by BMT'); # Process Rolling 3 Month NSI by Type/Model $lcSQL = <<ENDSQL; SELECT groupings AS [Type/Model], Count(satisfaction) AS Count, sum/count AS NSI, Sum(satisfaction) AS sum, StDev(satisfaction) AS StdDev, 1.96*(StdDev/Sqr(count)) AS CI, IIF(isnull([CI]),"","+/- " & Format((Int(([CI]+0.005)*100)/100),"#0.00")) AS [95% CI] FROM [RS6KCPC Rolling 3 Month Union] LEFT JOIN PDT_TypeModels ON [RS6KCPC Rolling 3 Month Union].typemodel = PDT_TypeModels.TypeModel WHERE satisfaction>=0 AND groupings<>'' GROUP BY groupings; ENDSQL Rolling_Query('TypeModel'); # Process Rolling 3 Month NSI by Install Month $lcSQL = <<ENDSQL; SELECT year & " - " & Format(month,"#00") AS Year_Month, Count(satisfaction) AS Count, sum/count AS NSI, Sum(satisfaction) AS sum, StDev(satisfaction) AS StdDev, 1.96*(StdDev/Sqr(count)) AS CI, IIF(isnull([CI]),"","+/- " & Format((Int(([CI]+0.005)*100)/100),"#0.00")) AS [95% CI] FROM [RS6KCPC Rolling 3 Month Union] WHERE satisfaction>=0 GROUP BY year, month; ENDSQL Rolling_Query('InstallMonth'); # Process Comment Keyword Count Table Keyword_Query('Keyword', 'RS6KCPC Comment Keyword Count Table'); # Build Summary worksheet Build_Summary('Summary'); $loAccess->SetOption("Default Database Directory", $lcSaveDir); $loAccess->SetOption("Default Database Directory", 'c:\WINNT\Profiles\Administrator\Personal'); unlink(cwd() . "\\" . 'monthxls.xls'); $loXlw->SaveAs(cwd() . "\\" . 'monthxls.xls'); exit; sub Common_Query { my $lcName = shift; # get worksheet name $lcSQL = shift; # get query name $loXls = $loXlw->WorkSheets->Add({after => $loXlw->Worksheets($loXlw->Worksheets->{Count})}); $loXls->{Name} = $lcName; # Name the Worksheet # get results of query $loRS = $loDatabase->OpenRecordset($lcSQL); if (Win32::OLE->LastError) { print "Common_Query Unable to Open Recordset($lcName), ", "LastError returned ", Win32::OLE->LastError, "\n"; } $lnRow = 1; $lncount = ''; $loRS->MoveFirst(); while (!$loRS->EOF()) { $loXls->Range("A$lnRow:D$lnRow")->{Value} = [ $lclabel = $loRS->Fields(0)->Value, $lnpercent = sprintf("%2.2f", $loRS->Fields('Percent')->Value), $lnnsi = sprintf("%2.1f", $loRS->Fields('NSI')->Value), $lcci = $loRS->Fields('95% CI')->Value ]; write if (clDEBUG); $lnRow++; $loRS->MoveNext(); } print "\n" if (clDEBUG); $loXls->Columns(2)->{NumberFormat} = '#0.00'; $loXls->Columns(3)->{NumberFormat} = '#0.0'; $loXls->Range("A:A")->{HorizontalAlignment} = xlLeft; $loXls->Range("C:D")->{HorizontalAlignment} = xlRight; $loXls->Range("A:D")->Columns->AutoFit; } sub Rolling_Query { my $lcName = shift; # get worksheet name $lcSQL =~ s/\n/ /g; # newline ==> space $loXls = $loXlw->WorkSheets->Add({after => $loXlw->Worksheets($loXlw->Worksheets->{Count})}); $loXls->{Name} = $lcName; # Name the Worksheet # get results of query $loRS = $loDatabase->OpenRecordset($lcSQL); if (Win32::OLE->LastError) { print "Rolling_Query Unable to Open Recordset($lcName), ", "LastError returned ", Win32::OLE->LastError, "\n"; } $lnRow = 1; $lnpercent = ''; $loRS->MoveFirst(); while (!$loRS->EOF()) { $loXls->Range("A$lnRow:D$lnRow")->{Value} = [$lclabel = $loRS->Fields(0)->Value, $lncount = $loRS->Fields('Count')->Value, $lnnsi = sprintf("%2.1f", $loRS->Fields('NSI')->Value), $lcci = $loRS->Fields('95% CI')->Value]; write if (clDEBUG); $lnRow++; $loRS->MoveNext(); } print "\n" if (clDEBUG); $loXls->Columns(2)->{NumberFormat} = '#0'; $loXls->Columns(3)->{NumberFormat} = '#0.0'; $loXls->Range("A:A")->{HorizontalAlignment} = xlLeft; $loXls->Range("B:D")->{HorizontalAlignment} = xlRight; $loXls->Range("A:D")->Columns->AutoFit; } sub Keyword_Query { my $lcName = shift; # get worksheet name $lcSQL = shift; # get query name $loXls = $loXlw->WorkSheets->Add({after => $loXlw->Worksheets($loXlw->Worksheets->{Count})}); $loXls->{Name} = $lcName; # Name the Worksheet # get results of query $loRS = $loDatabase->OpenRecordset($lcSQL); if (Win32::OLE->LastError) { print "Keyword_Query Unable to Open Recordset($lcName), ", "LastError returned ", Win32::OLE->LastError, "\n"; } $lnRow = 1; $loRS->MoveFirst(); while (!$loRS->EOF()) { $loXls->Range("A$lnRow:E$lnRow")->{Value} = [$lclabel = $loRS->Fields('Description')->Value, $lncount = $loRS->Fields('Positive')->Value, $lnpercent = sprintf("%2.2f", $loRS->Fields('% Positive')->Value), $lnnsi = $loRS->Fields('Negative')->Value, $lcci = sprintf("%2.2f", $loRS->Fields('% Negative')->Value)]; write if (clDEBUG); $lnRow++; $loRS->MoveNext(); } print "\n" if (clDEBUG); $loXls->Columns(2)->{NumberFormat} = '#0'; $loXls->Columns(3)->{NumberFormat} = '#0.00'; $loXls->Columns(4)->{NumberFormat} = '#0'; $loXls->Columns(5)->{NumberFormat} = '#0.00'; $loXls->Range("A:A")->{HorizontalAlignment} = xlLeft; $loXls->Range("B:E")->{HorizontalAlignment} = xlRight; $loXls->Range("A:E")->Columns->AutoFit; } sub Build_Summary { my $lcName = shift; # get worksheet name $loXls = $loXlw->WorkSheets->Add({before => $loXlw->Worksheets('Overall')}); $loXls->{Name} = $lcName; # Name the Worksheet $lnRow = $lnCol = 1; my ($intLoopRow, $intLoopCol); # Column labels $loXls->Range("B$lnRow:O$lnRow")->{Value} = ['Percent', 'NSI', '95% CI', undef, undef, 'Count', 'NSI', '95% CI', undef, undef, 'Positive', '%Positive', 'Negative', '% Negative']; # Overall $lnRow = 3; $loXls->Cells($lnRow, 1)->{Value} = 'Overall Satisfaction: (NSI)'; $loXls->Cells($lnRow, 1)->Font->{Italic} = TRUE; $lnRow++; $intLoopRow = 1; while ($intLoopRow < 2) { # Loop through each saved cell row $lnCol = $intLoopCol = 3; while ($intLoopCol < 5) { $loXls->Cells($lnRow, $lnCol)->{Value} = $loXlw->Worksheets('Overall')->Cells($intLoopRow, $intLoopCol)->Value; $lnCol++; $intLoopCol++; } $lnRow++; $intLoopRow++; } # BMT Move_Sheet1('BMT', 'RS/6000 BMT:'); # Channel Move_Sheet1('Channel', 'Respondent How Acquired:'); # Usage Move_Sheet1('Usage', 'Respondent Server/Workstation Usage:'); # Primary Usage Move_Sheet1('PrimeUse', 'Respondent Segments:'); # Source Move_Sheet1('Source', 'Respondent Installation Types:'); # Type/Model $lnRow = 2; # Move_Sheet2 immediately increments this so this is really 3 Move_Sheet2('TypeModel', 'Rolling 3 months by Type/Model Groupings:'); # Install Month Move_Sheet2('InstallMonth', 'Rolling 3 months by Install Month:'); # Keyword $lnRow = 3; $loXls->Cells($lnRow, 11)->{Value} = 'Comment Keyword Summary'; $loXls->Cells($lnRow, 11)->Font->{Italic} = TRUE; $lnRow++; my $lnLastRow = $loXlw->WorkSheets('KeyWord')->Cells(1,1)->End(xlDown)->{Row}; $intLoopRow = 1; while ($intLoopRow < $lnLastRow) { # Loop through each saved cell row $lnCol = 11; $intLoopCol = 1; while ($intLoopCol < 6) { $loXls->Cells($lnRow, $lnCol)->{Value} = $loXlw->Worksheets('Keyword')->Cells($intLoopRow, $intLoopCol)->Value; $lnCol++; $intLoopCol++; } $lnRow++; $intLoopRow++; } print "\n" if (clDEBUG); # Fix Formatting with($loXls->Columns(1), ColumnWidth => 20, HorizontalAlignment => xlLeft); with($loXls->Columns(2), NumberFormat => '#0.0', ColumnWidth => 7, HorizontalAlignment => xlRight); with($loXls->Columns(3), NumberFormat => '#0.0', ColumnWidth => 5, HorizontalAlignment => xlRight); with($loXls->Columns(4), ColumnWidth => 8, HorizontalAlignment => xlRight); $loXls->Columns(5)->{ColumnWidth} = 5; with($loXls->Columns(6), ColumnWidth => 9, HorizontalAlignment => xlLeft); with($loXls->Columns(7), NumberFormat => '#0', ColumnWidth => 6, HorizontalAlignment => xlRight); with($loXls->Columns(8), NumberFormat => '#0.0', ColumnWidth => 5, HorizontalAlignment => xlRight); with($loXls->Columns(9), ColumnWidth => 9, HorizontalAlignment => xlRight); $loXls->Columns(10)->{ColumnWidth} = 5; with($loXls->Columns(11), ColumnWidth => 44, HorizontalAlignment => xlLeft); with($loXls->Columns(12), NumberFormat => '#0', ColumnWidth => 8, HorizontalAlignment => xlRight); with($loXls->Columns(13), NumberFormat => '#0.00', ColumnWidth => 10, HorizontalAlignment => xlRight); with($loXls->Columns(14), NumberFormat => '#0', ColumnWidth => 8, HorizontalAlignment => xlRight); with($loXls->Columns(15), NumberFormat => '#0.00', ColumnWidth => 10, HorizontalAlignment => xlRight); with ($loXls->PageSetup, Zoom => Variant(VT_BOOL, 0), FitToPagesTall => 1, FitToPagesWide => 1, Orientation => xlLandscape); $loXls->PrintOut; } sub Move_Sheet1 { my ($lcName, $lcTitle) = @_; # worksheet name, title my $lnLastRow = $loXlw->WorkSheets($lcName)->Cells(1,1)->End(xlDown)->{Row}; $lnRow++; $loXls->Cells($lnRow, 1)->{Value} = $lcTitle; $loXls->Cells($lnRow, 1)->Font->{Italic} = TRUE; $lnRow++; my ($intLoopRow, $intLoopCol); $intLoopRow = 1; while ($intLoopRow < $lnLastRow) { # Loop through each saved cell row $lnCol = $intLoopCol = 1; while ($intLoopCol < 5) { $loXls->Cells($lnRow, $lnCol)->{Value} = $loXlw->Worksheets($lcName)->Cells($intLoopRow, $intLoopCol)->Value; $lnCol++; $intLoopCol++; } $lnRow++; $intLoopRow++; } } sub Move_Sheet2 { my ($lcName, $lcTitle) = @_; # worksheet name, title my $lnLastRow = $loXlw->WorkSheets($lcName)->Cells(1,1)->End(xlDown)->{Row}; $lnRow++; $loXls->Cells($lnRow, 6)->{Value} = $lcTitle; $loXls->Cells($lnRow, 6)->Font->{Italic} = TRUE; $lnRow++; my ($intLoopRow, $intLoopCol); $intLoopRow = 1; while ($intLoopRow < $lnLastRow) { # Loop through each saved cell row $lnCol = 6; $intLoopCol = 1; while ($intLoopCol < 5) { $loXls->Cells($lnRow, $lnCol)->{Value} = $loXlw->Worksheets($lcName)->Cells($intLoopRow, $intLoopCol)->Value; $loXls->Cells($lnRow, $lnCol)->Font->{Bold} = TRUE if ($lnCol == 6); $lnCol++; $intLoopCol++; } $lnRow++; $intLoopRow++; } } format STDOUT_TOP = Monthxls Debug Output Label Count Percent NSI 95% CI . format STDOUT = @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @>>> @>>>>>> @>>> @>>>>>>>> $lclabel, $lncount, $lnpercent, $lnnsi, $lcci . .
'************ Code End **********************