Probleme exportation de liste de StringGrid vers Excel

Version imprimable

Bonjour,

Pour sauvegarder deux liste de StringGrid dans un fihier Excel j'utilise la fonction suivante :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
//Exportation du contenu de StringGrid d'une liste de StringGrid vers Excel
function TFprincipal.StringGridToExcelSheet2(ListeGrid: array of TStringGrid; ListeGrid2: array of TStringGrid; SheetName, FileName: string;
  ShowExcel: Boolean): Boolean;
const
  xlWBATWorksheet = -4167;
var
  SheetCount,SheetColCount,SheetColCount2,SheetRowCount,SheetRowCount2,BookCount: Integer;
  XLApp, Sheet: OLEVariant;
  ListeData,ListeData2: array of OLEVariant;
  I, J, N, M, num_grid,num_data,indice_dep_ligne,indice_dep_colonne,total_colonne,total_ligne: Integer;
  SaveFileName : String;
begin
  num_grid:=1;
  //calcule la quantité de feuilles nécessaires
  SheetCount := (ListeGrid[num_grid].ColCount div 256) + 1;
  if ListeGrid[num_grid].ColCount mod 256 = 0 then
     SheetCount := SheetCount - 1;
  //calcule la quantité de classeurs nécessaires
  BookCount := (ListeGrid[num_grid].RowCount div 65536) + 1;
  if ListeGrid[num_grid].RowCount mod 65536 = 0 then
     BookCount := BookCount - 1;
 
  //Creation d'Excel-OLE Object
  Result := False;
  XLApp := CreateOleObject('Excel.Application');
  try
    //pointe sur la feuille excel
    if ShowExcel = false then
       XLApp.Visible := False
    else
       XLApp.Visible := True;
    //ajout Workbook
    for M := 1 to BookCount do
    begin
      XLApp.Workbooks.Add(xlWBATWorksheet);
      //place les feuilles
      for N := 1 to SheetCount - 1 do
      begin
        XLApp.Worksheets.Add;
      end;
    end;
    total_colonne:=0;
    total_ligne:=0;
    total_colonne:=total_colonne+ListeGrid[num_grid].ColCount+ListeGrid2[num_grid].ColCount;
    if length(ListeGrid)=1 then
       total_ligne:=ListeGrid[num_grid].RowCount;
    if length(ListeGrid)>1 then
      for num_grid:=1 to length(ListeGrid)-1 do
        total_ligne:=total_ligne+ListeGrid[num_grid].RowCount;
 
    //ajoute les colonnes
    if total_colonne <= 256 then SheetColCount := total_colonne
    else SheetColCount := 256;
    //ajoute les lignes
    if total_ligne <= 65536 then SheetRowCount := total_ligne
    else SheetRowCount := 65536;
 
    setlength(ListeData,length(ListeGrid));
    setlength (ListeData2,length(ListeGrid2));
    num_data:=1;
    //remplissage de la feuille
    for M := 1 to BookCount do
    begin
      for N := 1 to SheetCount do
      begin
        //va chercher les data
        for num_grid:=1 to length(ListeGrid)-1 do
          begin
            ListeData[num_data] := VarArrayCreate([1, ListeGrid[num_grid].RowCount, 1, ListeGrid[num_grid].ColCount], varVariant);
            ListeData2[num_data] := VarArrayCreate([1, ListeGrid2[num_grid].RowCount, 1, ListeGrid2[num_grid].ColCount], varVariant);
 
            for I := 0 to ListeGrid[num_grid].ColCount - 1 do
              for J := 0 to ListeGrid[num_grid].RowCount - 1 do
                if ((I+256*(N-1)) <= ListeGrid[num_grid].ColCount) and ((J+65536*(M-1)) <= ListeGrid[num_grid].RowCount) then
                  ListeData[num_data][J + 1, I + 1] := ListeGrid[num_grid].Cells[I+256*(N-1), J+65536*(M-1)];
 
            for I := 0 to ListeGrid2[num_grid].ColCount - 1 do
              for J := 0 to ListeGrid2[num_grid].RowCount - 1 do
                if ((I+256*(N-1)) <= ListeGrid2[num_grid].ColCount) and ((J+65536*(M-1)) <= ListeGrid2[num_grid].RowCount) then
                  ListeData2[num_data][J + 1, I + 1] := ListeGrid2[num_grid].Cells[I+256*(N-1), J+65536*(M-1)];
            num_data:=num_data+1;
          end;
 
        XLApp.Worksheets[N].Select;
        XLApp.Workbooks[M].Worksheets[N].Name := SheetName + IntToStr(N);
        //formate les cellules en string
        XLApp.Workbooks[M].Worksheets[N].Range[RefToCell(1, 1), RefToCell(SheetRowCount,
          SheetColCount)].Select;
        XLApp.Selection.NumberFormat := '@';
        XLApp.Workbooks[M].Worksheets[N].Range['A1'].Select;
        //remet les données en place
        Sheet := XLApp.Workbooks[M].WorkSheets[N];
 
        num_data:=1;
        indice_dep_ligne:=2;
        indice_dep_colonne:=1;
        for num_grid:=1 to length(ListeGrid)-1 do
          begin
            Sheet.Range[RefToCell(indice_dep_ligne, 1), RefToCell(ListeGrid[num_grid].RowCount+indice_dep_colonne,ListeGrid[num_grid].ColCount)].Value := ListeData[num_data];
            Sheet.Range[RefToCell(indice_dep_ligne, 6), RefToCell(ListeGrid2[num_grid].RowCount+indice_dep_colonne,ListeGrid2[num_grid].ColCount+5)].Value := ListeData2[num_data];
            indice_dep_ligne:=indice_dep_ligne + ListeGrid[num_grid].RowCount+1;
            indice_dep_colonne:=indice_dep_colonne+ListeGrid[num_grid].ColCount;
            num_data:=num_data+1;
          end;
      end;
    end;
    //Enregistre le classeur excel
    try
      for M := 1 to BookCount do
      begin
        //rajoute le numéro du classeur dans le nom de fichier choisi
        SaveFileName := Copy(FileName,1,Pos('.',FileName)-1) + IntToStr(M) +
        Copy(FileName,Pos('.',FileName),
        Length(FileName)-Pos('.',FileName)+1);
        XLApp.Workbooks[M].SaveAs(SaveFileName);
      end;
      Result := True;
    except
      // Error?
    end;
  finally
    //Excel termine
    if (not VarIsEmpty(XLApp)) and (ShowExcel = false) then
    begin
      XLApp.DisplayAlerts := False;
      XLApp.Quit;
      XLAPP := Unassigned;
      Sheet := Unassigned;
    end;
  end;
end;

Ce n'est pas moi qui l'est developpé et elle était sensé marcher correctement.
Seulement voilà quand j'exporte dans le fichier Excel la premiere Grid de la liste est bien enregistrée mais apres ca part en sucette.

Dans l'exemple que je test actuellement j'ai deux liste de 3 Grid contenant 5 lignes chacune plus un ligne d'entete chacune.
La premiere Grid est complete pour chaque liste, la deuxieme grid a sa ligne d'entete et 3 lignes, la 3eme grid a sa ligne d'entete et 1 seule ligne.

Voila je dois avouer que je ne comprend pas et le code de cetet fonction est loin d'être trivial pour moi et je ne vois pas ou ca peu merder.

Si quelqu'un pense voir le probleme se serait super sympa.

Merci

21/12/2005, 09h59
Kara

Juste pour preciser que dans le fichier Excel lorsqu'il manque des lignes du grid elle sont quand meme là mais vide.

C'est à dire que pour le deuxieme ou il n'y a que 3 lignes, il y a quand meme 5 lignes de reservées.

Voila si ca peut aider

Bonjour,
Peut tu essayer ce moceau de programme

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
 
function SaveAsExcelFile(StringGrid: TStringGrid; FileName: string): boolean;
const
  xlWBATWorksheet = -4167;
var
  Row, Col:     integer;
  GridPrevFile: string;
  XLApp, Sheet: OLEVariant;
begin
  Result := false;  
  XLApp := CreateOleObject('Excel.Application');
  try
    XLApp.Visible := False;
    XLApp.Workbooks.Add(xlWBatWorkSheet);
    Sheet      := XLApp.Workbooks[1].WorkSheets[1];
    Sheet.Name := 'My Sheet Name';
    for col := 0 to StringGrid.ColCount - 1 do
      for row := 0 to StringGrid.RowCount - 1 do
        Sheet.Cells[row + 1,col + 1] := StringGrid.Cells[col, row];
    try
      XLApp.Workbooks[1].SaveAs(FileName);
      Result := True;
    except
       // Error ?
    end;
  finally
    if not VarIsEmpty(XLApp) then
    begin
      XLApp.DisplayAlerts := False;
      XLApp.Quit;
      XLAPP := Unassigned;
      Sheet := Unassigned;
    end;
  end;
end;
 
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  If SaveAsExcelFile(StringGrid1,'c:MyExcelFile.xls') then
     ShowMessage('StringGrid saved!');
end;

Tirer de http://www.fobec.com/protec/trucs2/e...srub=SLogiciel

Heu oui.

Mais ca c'est pour un stringgrid unique et pour ca ca marche...

Mais avec un stringgrid unique et un ptit bouton oui la fonction que tu ma donné marche bien.

Par contre pour un grid unique moi j'utilise cette fonction là (juste pour info puisque celle ci marche très bien) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
//Exportation du contenu du StringGrid vers Excel
function TFprincipal.StringGridToExcelSheet(Grid: TStringGrid; Grid2: TStringGrid;  SheetName, FileName: string;
  ShowExcel: Boolean): Boolean;
const
  xlWBATWorksheet = -4167;
var
  SheetCount,SheetColCount,SheetRowCount,BookCount: Integer;
  XLApp, Sheet, Data,Data2: OLEVariant;
  I, J, N, M: Integer;
  SaveFileName : String;
begin
  //calcule la quantité de feuilles nécessaires
  SheetCount := (Grid.ColCount div 256) + 1;
  if Grid.ColCount mod 256 = 0 then
     SheetCount := SheetCount - 1;
  //calcule la quantité de classeurs nécessaires
  BookCount := (Grid.RowCount div 65536) + 1;
  if Grid.RowCount mod 65536 = 0 then
     BookCount := BookCount - 1;
 
  //Creation d'Excel-OLE Object
  Result := False;
  XLApp := CreateOleObject('Excel.Application');
  try
    //pointe sur la feuille excel
    if ShowExcel = false then
       XLApp.Visible := False
    else
       XLApp.Visible := True;
    //ajout Workbook
    for M := 1 to BookCount do
    begin
      XLApp.Workbooks.Add(xlWBATWorksheet);
      //place les feuilles
      for N := 1 to SheetCount - 1 do
      begin
        XLApp.Worksheets.Add;
      end;
    end;
    //ajoute les colonnes
 
    if Grid.ColCount+Grid2.ColCount <= 256 then SheetColCount := Grid.ColCount+Grid2.ColCount
    else SheetColCount := 256;
    //ajoute les lignes
    if Grid.RowCount+Grid2.RowCount <= 65536 then SheetRowCount := Grid.RowCount+Grid2.RowCount
    else SheetRowCount := 65536;
 
    //remplissage de la feuille
    for M := 1 to BookCount do
    begin
      for N := 1 to SheetCount do
      begin
        //va chercher les data
        Data := VarArrayCreate([1, Grid.RowCount, 1, Grid.ColCount], varVariant);
        Data2 := VarArrayCreate([1, Grid2.RowCount, 1, Grid2.ColCount], varVariant);
 
        for I := 0 to Grid.ColCount - 1 do
          for J := 0 to Grid.RowCount - 1 do
            if ((I+256*(N-1)) <= Grid.ColCount) and ((J+65536*(M-1)) <= Grid.RowCount) then
              Data[J + 1, I + 1] := Grid.Cells[I+256*(N-1), J+65536*(M-1)];
 
        for I := 0 to Grid2.ColCount - 1 do
          for J := 0 to Grid2.RowCount - 1 do
            if ((I+256*(N-1)) <= Grid2.ColCount) and ((J+65536*(M-1)) <= Grid2.RowCount) then
              Data2[J + 1, I + 1] := Grid2.Cells[I+256*(N-1), J+65536*(M-1)];
 
        XLApp.Worksheets[N].Select;
        XLApp.Workbooks[M].Worksheets[N].Name := SheetName + IntToStr(N);
        //formate les cellules en string
        XLApp.Workbooks[M].Worksheets[N].Range[RefToCell(1, 1), RefToCell(SheetRowCount,
          SheetColCount)].Select;
        XLApp.Selection.NumberFormat := '@';
        XLApp.Workbooks[M].Worksheets[N].Range['A1'].Select;
        //remet les données en place
        Sheet := XLApp.Workbooks[M].WorkSheets[N];
 
        Sheet.Range[RefToCell(2, 1), RefToCell(Grid.RowCount+1,Grid.ColCount)].Value := Data;
        Sheet.Range[RefToCell(2, 6), RefToCell(Grid2.RowCount+1,Grid2.ColCount+5)].Value := Data2;
      end;
    end;
    //Enregistre le classeur excel
    try
      for M := 1 to BookCount do
      begin
        //rajoute le numéro du classeur dans le nom de fichier choisi
        SaveFileName := Copy(FileName,1,Pos('.',FileName)-1) + IntToStr(M) +
        Copy(FileName,Pos('.',FileName),
        Length(FileName)-Pos('.',FileName)+1);
        XLApp.Workbooks[M].SaveAs(SaveFileName);
      end;
      Result := True;
    except
      // Error?
    end;
  finally
    //Excel termine
    if (not VarIsEmpty(XLApp)) and (ShowExcel = false) then
    begin
      XLApp.DisplayAlerts := False;
      XLApp.Quit;
      XLAPP := Unassigned;
      Sheet := Unassigned;
    end;
  end;
end;

Par contre elle est moins facile que la tienne je verrais pour implementer la tienne.

Par contre pour un liste de Grid je ne sait pas comment faire

Je continue a chercher :

Ces 2 boucles là se deroulent normalement c'est à dire qu'il y a bien le bon nombre de colonne et le bon nombre de lignes et que les données dans les listedata sont bonnes :

Code:

1
2
3
4
5
6
7
8
9
for I := 0 to ListeGrid[num_grid].ColCount - 1 do
              for J := 0 to ListeGrid[num_grid].RowCount - 1 do
                if ((I+256*(N-1)) <= ListeGrid[num_grid].ColCount) and ((J+65536*(M-1)) <= ListeGrid[num_grid].RowCount) then
                  ListeData[num_data][J + 1, I + 1] := ListeGrid[num_grid].Cells[I+256*(N-1), J+65536*(M-1)];
 
            for I := 0 to ListeGrid2[num_grid].ColCount - 1 do
              for J := 0 to ListeGrid2[num_grid].RowCount - 1 do
                if ((I+256*(N-1)) <= ListeGrid2[num_grid].ColCount) and ((J+65536*(M-1)) <= ListeGrid2[num_grid].RowCount) then
                  ListeData2[num_data][J + 1, I + 1] := ListeGrid2[num_grid].Cells[I+256*(N-1), J+65536*(M-1)];

Je pense donc que c'est à ce niveau là que les choses posent probleme :

Code:

1
2
3
4
5
6
7
8
9
10
11
num_data:=1;
        indice_dep_ligne:=2;
        indice_dep_colonne:=1;
        for num_grid:=1 to length(ListeGrid)-1 do
          begin
            Sheet.Range[RefToCell(indice_dep_ligne, 1), RefToCell(ListeGrid[num_grid].RowCount+indice_dep_colonne,ListeGrid[num_grid].ColCount)].Value := ListeData[num_data];
            Sheet.Range[RefToCell(indice_dep_ligne, 6), RefToCell(ListeGrid2[num_grid].RowCount+indice_dep_colonne,ListeGrid2[num_grid].ColCount+5)].Value := ListeData2[num_data];
            indice_dep_ligne:=indice_dep_ligne + ListeGrid[num_grid].RowCount+1;
            indice_dep_colonne:=indice_dep_colonne+ListeGrid[num_grid].ColCount;
            num_data:=num_data+1;
          end;

Seulement je ne comprnd pas bien cette partie là (enfin pas du tout pour être franc) et je n'arrive a rien afficher dans un showmessage (a part les listedata mais on sait qu'elles sont bonnes).

Voila personne voit se qui va pas?

21/12/2005, 13h25
Kara

Jme permet de faire remonter le post pasque la jsuis au point mort... :?
22/12/2005, 08h57
Kara

Petit up du matin, quelqu'un voit-il le pb?

Bon ba après pas mal de bidouille j'ai trouvé une solution qui marche :

AVANT

Code:

1
2
3
4
5
6
7
8
9
10
11
num_data:=1;
        indice_dep_ligne:=2;
        indice_dep_colonne:=1;
        for num_grid:=1 to length(ListeGrid)-1 do
          begin
            Sheet.Range[RefToCell(indice_dep_ligne, 1), RefToCell(ListeGrid[num_grid].RowCount+indice_dep_colonne,ListeGrid[num_grid].ColCount)].Value := ListeData[num_data];
            Sheet.Range[RefToCell(indice_dep_ligne, 6), RefToCell(ListeGrid2[num_grid].RowCount+indice_dep_colonne,ListeGrid2[num_grid].ColCount+5)].Value := ListeData2[num_data];
            indice_dep_ligne:=indice_dep_ligne + ListeGrid[num_grid].RowCount+1;
            indice_dep_colonne:=indice_dep_colonne+ListeGrid[num_grid].ColCount;
            num_data:=num_data+1;
          end;

APRES

Code:

1
2
3
4
5
6
7
8
9
10
11
12
num_data:=1;
        indice_dep_ligne:=2;
        indice_dep_colonne:=1;
        for num_grid:=1 to length(ListeGrid)-1 do
          begin
            Sheet.Range[RefToCell(indice_dep_ligne, 1), RefToCell((ListeGrid[num_grid].RowCount+indice_dep_ligne)-1,ListeGrid[num_grid].ColCount)].Value := ListeData[num_data];
            Sheet.Range[RefToCell(indice_dep_ligne, 6), RefToCell((ListeGrid2[num_grid].RowCount+indice_dep_ligne)-1,ListeGrid2[num_grid].ColCount+5)].Value := ListeData2[num_data];
            indice_dep_ligne:=indice_dep_ligne + ListeGrid[num_grid].RowCount+1;
            indice_dep_colonne:=indice_dep_colonne+ListeGrid2[num_grid].ColCount;
            //showmessage (inttostr(num_data));
            num_data:=num_data+1;
          end;

Merci de votre aide