Perl Spreadsheet :: ParseXLSX如何从Excel文件中获取图像？ [英] Perl Spreadsheet::ParseXLSX how to get images from Excel file?

问题描述

我正在尝试将多个单工作表Excel文件合并到一个多工作表巨大文件中。

I'm trying to merge several single-worksheet Excel files into one multi-worksheet huge file.

我正在使用 Spreadsheet :: ParseXLSX ， Spreadsheet :: ParseExcel :: Format 和 Excel :: Writer :: XLSX 实现此目的。它工作正常，但仅适用于数据。我对图像无能为力。

I am using Spreadsheet::ParseXLSX, Spreadsheet::ParseExcel::Format and Excel::Writer::XLSX to achieve this. It works correctly, but only for data. I can't do anything with the images.

以下是精彩但不完整的代码：

Here is the wonderful but incomplete code:

# Pour une meilleure programmation
use strict;
use warnings;

$|++;

use Spreadsheet::ParseXLSX;
use Spreadsheet::ParseExcel::Format;
use Excel::Writer::XLSX;

my @files = ( "file1.xlsx", "file2.xlsx", "file3.xlsx" );

my $fichier_sortie = "out_merged.xlsx";
my $out_workbook   = Excel::Writer::XLSX->new($fichier_sortie);

my $parser = Spreadsheet::ParseXLSX->new;

for my $f ( 0 .. $#files ) {

    print "=== " . $files[$f] . " =======================\n";

    my $in_workbook = $parser->parse( $files[$f] );

    if ( ! defined $in_workbook ) {
        die $parser->error(), ".\n";
    }

    my $in_worksheet = $in_workbook->worksheet(0);

    my $sheet
        = $out_workbook->add_worksheet( $in_worksheet->get_name() );

    my ( $row_min, $row_max ) = $in_worksheet->row_range();
    my ( $col_min, $col_max ) = $in_worksheet->col_range();

    for my $row ( $row_min .. $row_max ) {
        for my $col ( $col_min .. $col_max ) {
            my $cell = $in_worksheet->get_cell( $row, $col );
            next unless $cell;

            my $in_format  = $cell->get_format();
            my $out_format = $out_workbook->add_format();
            CopyFormat( $in_format, $out_format );
            $sheet->write( $row, $col, $cell->value(), $out_format );
        }
    }

    if ( defined( $in_worksheet->get_merged_areas() ) ) {
        my $merged_areas = $in_worksheet->get_merged_areas();

        my $cnt = 0;
        while ( defined( $merged_areas->[$cnt] ) ) {

            my $first_row = $merged_areas->[$cnt]->[0];
            my $first_col = $merged_areas->[$cnt]->[1];
            my $last_row  = $merged_areas->[$cnt]->[2];
            my $last_col  = $merged_areas->[$cnt]->[3];

            my $cell       = $in_worksheet->get_cell( $first_row, $first_col );
            my $in_format  = $cell->get_format();
            my $out_format = $out_workbook->add_format();
            CopyFormat( $in_format, $out_format );

            $sheet->merge_range(
                $first_row, $first_col,     $last_row,
                $last_col,  $cell->value(), $out_format
            );
            $cnt++;
        }
    }
}

$out_workbook->close();

## SUBS #######################################################################
sub CopyFormat() {
    use Switch;

    my $in_format  = shift;
    my $out_format = shift;

    # Font
    my $font = $in_format->{Font};
    $out_format->set_font( $font->{Name} );
    $out_format->set_bold( $font->{Bold} );
    $out_format->set_italic( $font->{Italic} );
    $out_format->set_size( $font->{Height} );
    $out_format->set_underline( $font->{UnderlineStyle} );
    $out_format->set_color( $font->{Color} );
    $out_format->set_font_strikeout( $font->{Strikeout} );
    $out_format->set_font_script( $font->{Super} );

    #Format
    my $align;
    switch ( $in_format->{AlignH} ) {

        #case 0 { $align = 'No alignment'; }
        case 1 { $align = 'left'; }
        case 2 { $align = 'center'; }
        case 3 { $align = 'right'; }
        case 4 { $align = 'fill'; }
        case 5 { $align = 'justify'; }
        case 6 { $align = 'center_across'; }

        #case 7 { $align = 'Distributed/Equal spaced'; }
        else { $align = ''; }
    }
    $out_format->set_align($align);

    switch ( $in_format->{AlignV} ) {
        case 0 { $align = 'top'; }
        case 1 { $align = 'vcenter'; }
        case 2 { $align = 'bottom'; }
        case 3 { $align = 'vjustify'; }

        #case 4 { $align='Distributed/Equal spaced';}
        else { $align = ''; }
    }
    $out_format->set_align($align);

    $out_format->set_indent( $in_format->{Indent} );
    $out_format->set_text_wrap( $in_format->{Wrap} );
    $out_format->set_shrink( $in_format->{Shrink} );

    my $rotation = $in_format->{Rotate};
    if ( ! defined($rotation) ) {
        $rotation = 0;
    }
    elsif ( $rotation == 255 ) {
        $rotation = 270;
    }
    $out_format->set_rotation($rotation);
    $out_format->set_text_justlast( $in_format->{JustLast} );

    #   $in_format->{ReadDir});

    my $border = $in_format->{BdrStyle};
    $out_format->set_bottom( $border->[3] );
    $out_format->set_top( $border->[2] );
    $out_format->set_left( $border->[0] );
    $out_format->set_right( $border->[1] );

    my $border_color = $in_format->{BdrColor};
    if ( defined( $border_color->[3] ) ) {
        $out_format->set_bottom_color( $border_color->[3] );
    }

    if ( defined( $border_color->[2] ) ) {
        $out_format->set_top_color( $border_color->[2] );
    }

    if ( defined( $border_color->[0] ) ) {
        $out_format->set_left_color( $border_color->[0] );
    }

    if ( defined( $border_color->[1] ) ) {
        $out_format->set_right_color( $border_color->[1] );
    }

    #   (my$kind, my$style, my$color)=$in_format->{BdrDiag};
    #   $out_format->set_diag_type($kind);
    #   $out_format->set_diag_border($style);
    #   $out_format->set_diag_color($color);

    my $fill = $in_format->{Fill};
    $out_format->set_pattern( $fill->[0] );
    if ( $fill->[0] != 0 ) {
        $out_format->set_fg_color( $fill->[2] );
        $out_format->set_bg_color( $fill->[1] );
    }

    #   $in_format->{Lock});
    #   $in_format->{Hidden});
    #   $in_format->{Style});
}

推荐答案

我很惭愧，但是没有Perl我确实经历过这个。我使用了.vbs文件和Excel宏。

I'm ashamed, but I did go through this without Perl. I've used a .vbs file and Excel macro.

抱歉。

对于那些可能想要的人知道，这里是.vbs：

For those who might want to know, here is the .vbs :

Option Explicit

On Error Resume Next

ExcelMacroExample


Sub ExcelMacroExample() 
    Dim xlApp 
    Dim xlBook 

    Set xlApp = CreateObject("Excel.Application") 
    xlApp.Visible = false

    Set xlBook = xlApp.Workbooks.Open("U:\DÉVELOPPEMENT\GENESYS\Perl\Tests\test_vba.xlsm",0,True) 

    xlApp.Run "PasserLesDonnees"

    xlBook.Saved = True
    xlBook.Close
    xlApp.Quit 

    xlApp.Visible = true

    Set xlBook = Nothing 
    Set xlApp = Nothing 

End Sub

以下是Excel文件的模块部分中的代码：

And here is the code in the Module section of the Excel file :

Sub PasserLesDonnees()
    Dim x, NbFichiers As Integer
    Dim ListeFichier() As Variant
    Dim FichierSortie As String

    ' calculer le nombre de fichiers à combiner
    NbFichiers = Range("A2", Range("A2").End(xlDown)).Rows.Count

    ' Cacher Excel le temp que les créations et déplacements aient lieu
'    Application.Visible = False
    ' Afficher la fenêtre de progression
    UserForm1.Show (0)
    UserForm1.Label1.Caption = "Transfert de " & NbFichiers & " fichiers en cours d'exécution"

    ' Classer les données par fichier de sortie et positions
    Columns("A:C").Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("C2"), Order2:=xlAscending, Header:=xlYes

    ' Parcourir toutes les lignes
    For x = 1 To NbFichiers
        If FichierSortie <> Cells(x + 1, 2) Then
            ReDim ListeFichier(0) As Variant
            FichierSortie = Cells(x + 1, 2)
        End If

        ReDim Preserve ListeFichier(UBound(ListeFichier) + 1) As Variant
        ' add value on the end of the array
        ListeFichier(UBound(ListeFichier)) = Cells(x + 1, 1).Value

        If (Cells(x + 1, 2) <> Cells(x + 2, 2)) Then
            Combiner FichierSortie, ListeFichier
        End If

        progress (Int(x / NbFichiers * 100))
    Next

    Unload UserForm1
'    Application.Visible = True

End Sub

Sub Combiner(FichierSortie As String, ListeFichier As Variant)
    ' Détruire le fichier de destination, à modifier si on doit renommer ou garder...
    DeleteFile ("U:\DÉVELOPPEMENT\GENESYS\Perl\Tests\" & FichierSortie)

    ' Tenter de faire disparaitre les messages...
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = True

    ' Créer un nouveau fichier excel à partir d'un template... qui est un fichier vide!
    Set NewBook = Workbooks.Add("U:\DÉVELOPPEMENT\GENESYS\Perl\Tests\TemplateVide.xlsx")

    ' Passer à travers la liste des fichiers et en faire les copies
    For i = LBound(ListeFichier) + 1 To UBound(ListeFichier)
        Set Wkb = Workbooks.Open(FileName:="U:\DÉVELOPPEMENT\GENESYS\Perl\Tests\" & ListeFichier(i), ReadOnly:=True)   ' Ouvrir le fichier d'origine
        For Each WS In Wkb.Worksheets                           ' Pour chacune des pages
            WS.Copy After:=NewBook.Sheets(NewBook.Sheets.Count) ' La copier en dernière position dans le nouveau fichier
        Next WS
        Wkb.Close False                                         ' Fermer le fichier d'origine
    Next i

    NewBook.Sheets("ToDelete").Delete   ' Éliminer la page vide du Template de base

    ' Enregistrer le fichier sous le bon nom
    NewBook.SaveAs ("U:\DÉVELOPPEMENT\GENESYS\Perl\Tests\" & FichierSortie)
    ' Fermer le fichier
    NewBook.Close (True)

    ' Replacer les options d'Excel comme il faut
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

Sub DeleteFile(ByVal FileToDelete As String)
   If FileExists(FileToDelete) Then
      SetAttr FileToDelete, vbNormal
      Kill FileToDelete
   End If
End Sub

Function FileExists(ByVal FileToTest As String) As Boolean
   FileExists = (Dir(FileToTest) <> "")
End Function

Sub progress(pctCompl As Single)

UserForm1.Text.Caption = pctCompl & "% fait"
UserForm1.Bar.Width = pctCompl * 3

DoEvents

End Sub

对不起法国评论，我确实住在魁北克省！用法语讲话，生活和工作。

Sorry for the french comment, I do live in Québec! Speak, live and work in French.

这篇关于Perl Spreadsheet :: ParseXLSX如何从Excel文件中获取图像？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！