in reply to Re: Perl OLE Excel Sort By Color
in thread Perl OLE Excel Sort By Color

Hi All, Thank you very much for your input. Here is the working code. 
my $Class = "Excel.Application";
my $excel = Win32::OLE->GetActiveObject($Class);
 if ( ! $excel )
 {
  $excel = new Win32::OLE( $Class )
   || die "Could not create an OLE '$Class' object";
 }
$excel -> {Visible} = 1;
$excel->{'DisplayAlerts'} = 0;
sortByColor("D:/sort.xls",12);

sub sortByColor()
{
    my $filename = $_[0];
    my $no_of_columns = $_[1];
    $excel->{DisplayAlerts}=0;
    my $workbook = $excel->Workbooks->Open($filename);
    my $sheet1=$workbook-> Activesheet;
    my $rows= $sheet1->UsedRange->Rows->{'Count'}; 
    my $cols= $sheet1->UsedRange->Columns->{'Count'};
    my $lastColumn =  colIdToString($cols);
    $sheet1->Range("A1:" . $lastColumn . $rows)->Select();
    $sheet1->Sort->SortFields->Clear();
    $sheet1->Sort->SortFields->Add($sheet1->Range("A2:A" . $rows),xlSo
+rtOnCellColor, xlAscending, xlSortNormal)->SortOnValue->{Color} = RGB
+(255, 0, 0);
    for (my $i = 1; $i <= $no_of_columns; $i++)
    {
        my $columnString = colIdToString($i);
        say "Adding COlumn $columnString to Sort";
        $sheet1->Sort->SortFields->Add($sheet1->Range($columnString . 
+"2:" . $columnString . $rows),xlSortOnCellColor, xlAscending, xlSortN
+ormal)->SortOnValue->{Color} = RGB(255, 255, 0);        
    }
    $sheet1->Sort->SetRange($sheet1->Range("A1:" . $lastColumn . $rows
+));
    say Win32::OLE->LastError();
    $sheet1->Sort->{Header} = xlYes;
    $sheet1->Sort->{MatchCase} = "False";
    $sheet1->Sort->{Orientation} = xlTopToBottom;
    $sheet1->Sort->{SortMethod} = xlPinYin;
    $sheet1->Sort->Apply;
}

sub RGB {
    my ( $red, $green, $blue ) = @_;
    return $red + ($green<<8) + ($blue<<16);
}
sub colIdToString{
    my $col = $_[0];
    my $column = "";
    switch ($col) {
            case 1 {$column="A"}
            case 2 {$column="B"}
            case 3 {$column="C"}
            case 4 {$column="D"}        
            case 5 {$column="E"}
            case 6 {$column="F"}
            case 7 {$column="G"}
            case 8 {$column="H"}
            case 9 {$column="I"}
            case 10 {$column="J"}
            case 11 {$column="K"}
            case 12 {$column="L"}
            case 13 {$column="M"}
            case 14 {$column="N"}
            case 15 {$column="O"}
            case 16 {$column="P"}
            case 17 {$column="Q"}
            case 18 {$column="R"}
            case 19 {$column="S"}
            case 20 {$column="T"}
            case 21 {$column="U"}
            case 22 {$column="V"}
            case 23 {$column="W"}
            case 24 {$column="X"}
            case 25 {$column="Y"}
            case 26 {$column="Z"}
        }
    return $column;
}

[download]

Replies are listed 'Best First'.
Re^3: Perl OLE Excel Sort By Color
by hdb (Monsignor) on Jun 03, 2015 at 06:25 UTC

    May I offer a slightly more general alternative to your sub colIdToString: 

    sub colIdToString {
    my $col = shift;
    my $column = "";
    while( $col ) {
        my $remainder = ($col-1) % 26 + 1;
        $column = chr( $remainder + 64 ).$column;
        $col -= $remainder;
        $col /= 26;
    }
    return $column;
}

    [download]
[reply]
[d/l]

      Thank You. It worked like a charm.

[reply]
Re^3: Perl OLE Excel Sort By Color
by AnomalousMonk (Archbishop) on Jun 03, 2015 at 12:49 UTC
    sortByColor("D:/sort.xls",12);

    sub sortByColor()
    {
        my $filename = $_[0];
        my $no_of_columns = $_[1];
        ...
    }

    You are still prototyping the  sortByColor subroutine to take no parameters. You are calling the subroutine and passing it two parameters in such a way as to defeat prototype checking. I suppose one might ask why one would use prototypes in such a way, but if you're happy with the code, so am I!

    More importantly, you also are apparently running your code without warnings enabled. I think this is a bad idea for one new to Perl coding (and also for the experienced): I strongly recommend that you enable them.

    Give a man a fish:  <%-(-(-(-<

[reply]
[d/l]
[select]
      Hi, I have modified the code. 
      sortByColor("D:/sort.xls",12); 

sub sortByColor 
{ 
    my $filename = $_[0]; 
    my $no_of_columns = $_[1]; 
    ... 
    }

      [download]
      And I am using the following modules. I did not paste the m here before. 
      use strict;
use warnings;
use POSIX qw(strftime);
use Net::Google::Drive::Simple;
use WWW::Mechanize;
use HTTP::Cookies;
use LWP::Debug qw(+);
use URL::Encode;
use URI::Escape;
use Date::Simple qw(date);
use File::Copy;
use Data::Table::Excel;
use Data::Dumper;
use Modern::Perl;
use Tie::File qw();
use Switch;
use Win32::OLE::Const "Microsoft Excel";
use Digest::MD5 qw(md5_hex);
use IO::Uncompress::Unzip qw(unzip $UnzipError);

      [download]
      This script automates a process that usually takes 5 hours of manual work each day. And I was able to reduce it to 15 mins. Thank you all for your help.I completed it.
[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom