Como adicionar ProgressBar no Código

Delphi

Firebird

Lógica de programação

23/04/2020

Estou Fazendo uma importação do excel para o Firebird usando o código abaixo, porém preciso adicionar uma ProgressBar para ver o progresso da importação,
como adiciono no código abaixo?


function TfrmImporta.Xls_To_StringGrid(cdsmateriais: TClientDataSet;
xFileXLS: string): Boolean;
const
xlCellTypeLastCell = $0000000B;
var
XLApp, Sheet: OLEVariant;
RangeMatrix: Variant;
x, y, k: Integer;
begin
Result := False;
XLApp := CreateOleObject('Excel.Application');
try
XLApp.Visible := False;
XLApp.Workbooks.Open(XFileXLS);
Sheet := XLApp.Workbooks[ExtractFileName(xFileXLS)].WorkSheets[1];

Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;
x := XLApp.ActiveCell.Row;
y := XLApp.ActiveCell.Column;

RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value;
k := 1;
cdsmateriais.DisableControls;
try
repeat
cdsmateriais.Append;
cdsmateriais.FieldByName('CODIGOTISS').asString := XLApp.cells[k,1];
cdsmateriais.FieldByName('TISSTPTABELA').asString := XLApp.cells[k,2];
cdsmateriais.FieldByName('TISSCODMATERIAL').asString := XLApp.cells[k,3];
cdsmateriais.FieldByName('NOMECOMERCIAL').asString := XLApp.cells[k,4];
cdsmateriais.FieldByName('DESCRICAODOPRODUTO').asString := XLApp.cells[k,5];
cdsmateriais.FieldByName('ESPECIALIDADEPRODUTO').asString := XLApp.cells[k,6];
cdsmateriais.FieldByName('CLASSIFICACAOPRODUTO').asString := XLApp.cells[k,7];
cdsmateriais.FieldByName('NOMETECNICO').asString := XLApp.cells[k,8];
cdsmateriais.FieldByName('UNIDMINFRACAO').asString := XLApp.cells[k,9];
cdsmateriais.FieldByName('CNPJFABRICANTEIMPORTADOR').asString := XLApp.cells[k,10];
cdsmateriais.FieldByName('DETENTORREGISTROANVISA').asString := XLApp.cells[k,11];
cdsmateriais.FieldByName('REGISTROANVISA').asString := XLApp.cells[k,12];
cdsmateriais.FieldByName('TAXADECUSTOS').asString := XLApp.cells[k,13];
cdsmateriais.FieldByName('VALORMAXIMO').asString := XLApp.cells[k,14];
cdsmateriais.FieldByName('OBSERVACOES').asString := XLApp.cells[k,15];
cdsmateriais.FieldByName('TISSCODANTERIOR').asString := XLApp.cells[k,16];
cdsmateriais.FieldByName('CODANTERIOR').asString := XLApp.cells[k,17];
cdsmateriais.FieldByName('REFTAMANHOMODELO').asString := XLApp.cells[k,18];
cdsmateriais.FieldByName('TIPODEPRODUTO').asString := XLApp.cells[k,19];
cdsmateriais.FieldByName('TIPODECODIFICACAO').asString := XLApp.cells[k,20];
cdsmateriais.FieldByName('DATAINICIOVIGENCIA').asString := XLApp.cells[k,21];
cdsmateriais.FieldByName('DATAFIMVIGENCIA').asString := XLApp.cells[k,22];
cdsmateriais.FieldByName('MOTIVODEINSERCAO').asString := XLApp.cells[k,23];
cdsmateriais.FieldByName('DATAFIMIMPLANTACAO').asString := XLApp.cells[k,24];
cdsmateriais.FieldByName('CODSIMPRO').asString := XLApp.cells[k,25];
cdsmateriais.FieldByName('DESCRICAOPRODUTOSIMPRO').asString := XLApp.cells[k,26];
cdsmateriais.FieldByName('EQUIVALENCIATECNICA').asString := XLApp.cells[k,27];



cdsmateriais.Post;
cdsmateriais.ApplyUpdates(0);
Inc(k, 1);
until k > x;

finally
cdsmateriais.EnableControls;
end
finally
if not VarIsEmpty(XLApp) then
begin
XLApp.WorkBooks.Close;
XLApp.Quit;
XLAPP := Unassigned;
Sheet := Unassigned;
Result := True;
ShowMessage('Planilha importada com sucesso!');
end;
end;
end;

end.
Vandeir

Vandeir

Curtidas 0

Respostas

Emerson Nascimento

Emerson Nascimento

23/04/2020

veja se isso te ajuda.
foque nos trechos que envolvem a barra de progresso. as demais alterações não são importantes para o código; foi somente um exercício.
function TfrmImporta.Xls_To_StringGrid(cdsmateriais: TClientDataSet;
xFileXLS: string): Boolean;
type
  TMapaCampo = record
    Campo: string;
    ColunaPlanilha: integer;
  end;
const
  xlCellTypeLastCell = $0000000B;
  MapaCampos: array[0..26] of TMapaCampo = (
      (Campo: 'CODIGOTISS'; ColunaPlanilha: 1),
      (Campo: 'TISSTPTABELA'; ColunaPlanilha: 2),
      (Campo: 'TISSCODMATERIAL'; ColunaPlanilha: 3),
      (Campo: 'NOMECOMERCIAL'; ColunaPlanilha: 4),
      (Campo: 'DESCRICAODOPRODUTO'; ColunaPlanilha: 5),
      (Campo: 'ESPECIALIDADEPRODUTO'; ColunaPlanilha: 6),
      (Campo: 'CLASSIFICACAOPRODUTO'; ColunaPlanilha: 7),
      (Campo: 'NOMETECNICO'; ColunaPlanilha: 8),
      (Campo: 'UNIDMINFRACAO'; ColunaPlanilha: 9),
      (Campo: 'CNPJFABRICANTEIMPORTADOR'; ColunaPlanilha: 10),
      (Campo: 'DETENTORREGISTROANVISA'; ColunaPlanilha: 11),
      (Campo: 'REGISTROANVISA'; ColunaPlanilha: 12),
      (Campo: 'TAXADECUSTOS'; ColunaPlanilha: 13),
      (Campo: 'VALORMAXIMO'; ColunaPlanilha: 14),
      (Campo: 'OBSERVACOES'; ColunaPlanilha: 15),
      (Campo: 'TISSCODANTERIOR'; ColunaPlanilha: 16),
      (Campo: 'CODANTERIOR'; ColunaPlanilha: 17),
      (Campo: 'REFTAMANHOMODELO'; ColunaPlanilha: 18),
      (Campo: 'TIPODEPRODUTO'; ColunaPlanilha: 19),
      (Campo: 'TIPODECODIFICACAO'; ColunaPlanilha: 20),
      (Campo: 'DATAINICIOVIGENCIA'; ColunaPlanilha: 21),
      (Campo: 'DATAFIMVIGENCIA'; ColunaPlanilha: 22),
      (Campo: 'MOTIVODEINSERCAO'; ColunaPlanilha: 23),
      (Campo: 'DATAFIMIMPLANTACAO'; ColunaPlanilha: 24),
      (Campo: 'CODSIMPRO'; ColunaPlanilha: 25),
      (Campo: 'DESCRICAOPRODUTOSIMPRO'; ColunaPlanilha: 26),
      (Campo: 'EQUIVALENCIATECNICA'; ColunaPlanilha: 27)
    );
var
  XLApp, Sheet: OLEVariant;
  RangeMatrix: Variant;
  i, x, y, k, iTotLin: Integer;
begin
  Result := False;
  XLApp := CreateOleObject('Excel.Application');
  try

    XLApp.Visible := False;
    XLApp.Workbooks.Open(XFileXLS);

    Sheet := XLApp.Workbooks[ExtractFileName(xFileXLS)].WorkSheets[1];
    Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;

    // obtém o número de linhas utilizadas
    iTotLin := Sheet.UsedRange.Rows.Count;

    x := XLApp.ActiveCell.Row;
    y := XLApp.ActiveCell.Column;

    RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value;
    k := 1;
    cdsmateriais.DisableControls;

    // indica qual o número total de iterações da barra de progresso
    ProgressBar1.Max := iTotLin;

    try
      repeat
        // incrementa a barra de progresso
        ProgressBar1.StepIt;

        cdsmateriais.Append;
        for i := Low(MapaCampos) to High(MapaCampos) do
          cdsmateriais.FieldByName(MapaCampos[i].Campo).AsString := XLApp.cells[k,MapaCampos[i].ColunaPlanilha];
        cdsmateriais.Post;

        cdsmateriais.ApplyUpdates(0);
        Inc(k, 1);

        // atualiza a tela
        Application.processMessages;

      until k > x;

    finally
      cdsmateriais.EnableControls;
    end
  finally
    if not VarIsEmpty(XLApp) then
    begin
      XLApp.WorkBooks.Close;
      XLApp.Quit;
      XLAPP := Unassigned;
      Sheet := Unassigned;
      Result := True;
      ShowMessage('Planilha importada com sucesso!');
    end;
  end;
end;

GOSTEI 0
Vandeir

Vandeir

23/04/2020

Emerson, Obrigado pela ajuda, com as alterações que vc fez no código, funcionou perfeitamente e a velocidade de importação aumentou muito. Porém ainda estou com um problema devido a quantidade de registros ser muito grande, a planilha têm quase 1.000.000 de linhas e quando vou importar dá o erro "out of memory", ae para conseguir importar estou dividindo em 10 planilhas de 100.000 registros cada.


veja se isso te ajuda.
foque nos trechos que envolvem a barra de progresso. as demais alterações não são importantes para o código; foi somente um exercício.
function TfrmImporta.Xls_To_StringGrid(cdsmateriais: TClientDataSet;
xFileXLS: string): Boolean;
type
  TMapaCampo = record
    Campo: string;
    ColunaPlanilha: integer;
  end;
const
  xlCellTypeLastCell = $0000000B;
  MapaCampos: array[0..26] of TMapaCampo = (
      (Campo: 'CODIGOTISS'; ColunaPlanilha: 1),
      (Campo: 'TISSTPTABELA'; ColunaPlanilha: 2),
      (Campo: 'TISSCODMATERIAL'; ColunaPlanilha: 3),
      (Campo: 'NOMECOMERCIAL'; ColunaPlanilha: 4),
      (Campo: 'DESCRICAODOPRODUTO'; ColunaPlanilha: 5),
      (Campo: 'ESPECIALIDADEPRODUTO'; ColunaPlanilha: 6),
      (Campo: 'CLASSIFICACAOPRODUTO'; ColunaPlanilha: 7),
      (Campo: 'NOMETECNICO'; ColunaPlanilha: 8),
      (Campo: 'UNIDMINFRACAO'; ColunaPlanilha: 9),
      (Campo: 'CNPJFABRICANTEIMPORTADOR'; ColunaPlanilha: 10),
      (Campo: 'DETENTORREGISTROANVISA'; ColunaPlanilha: 11),
      (Campo: 'REGISTROANVISA'; ColunaPlanilha: 12),
      (Campo: 'TAXADECUSTOS'; ColunaPlanilha: 13),
      (Campo: 'VALORMAXIMO'; ColunaPlanilha: 14),
      (Campo: 'OBSERVACOES'; ColunaPlanilha: 15),
      (Campo: 'TISSCODANTERIOR'; ColunaPlanilha: 16),
      (Campo: 'CODANTERIOR'; ColunaPlanilha: 17),
      (Campo: 'REFTAMANHOMODELO'; ColunaPlanilha: 18),
      (Campo: 'TIPODEPRODUTO'; ColunaPlanilha: 19),
      (Campo: 'TIPODECODIFICACAO'; ColunaPlanilha: 20),
      (Campo: 'DATAINICIOVIGENCIA'; ColunaPlanilha: 21),
      (Campo: 'DATAFIMVIGENCIA'; ColunaPlanilha: 22),
      (Campo: 'MOTIVODEINSERCAO'; ColunaPlanilha: 23),
      (Campo: 'DATAFIMIMPLANTACAO'; ColunaPlanilha: 24),
      (Campo: 'CODSIMPRO'; ColunaPlanilha: 25),
      (Campo: 'DESCRICAOPRODUTOSIMPRO'; ColunaPlanilha: 26),
      (Campo: 'EQUIVALENCIATECNICA'; ColunaPlanilha: 27)
    );
var
  XLApp, Sheet: OLEVariant;
  RangeMatrix: Variant;
  i, x, y, k, iTotLin: Integer;
begin
  Result := False;
  XLApp := CreateOleObject('Excel.Application');
  try

    XLApp.Visible := False;
    XLApp.Workbooks.Open(XFileXLS);

    Sheet := XLApp.Workbooks[ExtractFileName(xFileXLS)].WorkSheets[1];
    Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;

    // obtém o número de linhas utilizadas
    iTotLin := Sheet.UsedRange.Rows.Count;

    x := XLApp.ActiveCell.Row;
    y := XLApp.ActiveCell.Column;

    RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value;
    k := 1;
    cdsmateriais.DisableControls;

    // indica qual o número total de iterações da barra de progresso
    ProgressBar1.Max := iTotLin;

    try
      repeat
        // incrementa a barra de progresso
        ProgressBar1.StepIt;

        cdsmateriais.Append;
        for i := Low(MapaCampos) to High(MapaCampos) do
          cdsmateriais.FieldByName(MapaCampos[i].Campo).AsString := XLApp.cells[k,MapaCampos[i].ColunaPlanilha];
        cdsmateriais.Post;

        cdsmateriais.ApplyUpdates(0);
        Inc(k, 1);

        // atualiza a tela
        Application.processMessages;

      until k > x;

    finally
      cdsmateriais.EnableControls;
    end
  finally
    if not VarIsEmpty(XLApp) then
    begin
      XLApp.WorkBooks.Close;
      XLApp.Quit;
      XLAPP := Unassigned;
      Sheet := Unassigned;
      Result := True;
      ShowMessage('Planilha importada com sucesso!');
    end;
  end;
end;

GOSTEI 0
Emerson Nascimento

Emerson Nascimento

23/04/2020

O problema deve ser porque o dataset está crescendo muito.
dependendo de como está teu dataset, você poderá fechá-lo e abri-lo quando alcançar um certo número de registros gravados.
coloque no teu dataset algo como: SELECT * FROM TABELA WHERE CAMPO = X, onde X é um valor que você sabe que NÃO retornará registros.
por exemplo:
SELECT * FROM CLIENTE WHERE CNPJ = 'A'

em teoria nunca será retornado um registro com a instrução acima, porque não há CNPJ com conteúdo 'A' (para o exemplo suponho que o campo seja alfanumérico).
desta forma, o dataset sempre virá vazio quando aberto.
então você coloca um contador e fecha o dataset quando alcançar um determinado número de registros.
esta forma é para que sejam feitas alterações mínimas no teu código.
ficaria assim:
function TfrmImporta.Xls_To_StringGrid(cdsmateriais: TClientDataSet;
xFileXLS: string): Boolean;
type
  TMapaCampo = record
    Campo: string;
    ColunaPlanilha: integer;
  end;
const
  xlCellTypeLastCell = $0000000B;
  MapaCampos: array[0..26] of TMapaCampo = (
      (Campo: 'CODIGOTISS'; ColunaPlanilha: 1),
      (Campo: 'TISSTPTABELA'; ColunaPlanilha: 2),
      (Campo: 'TISSCODMATERIAL'; ColunaPlanilha: 3),
      (Campo: 'NOMECOMERCIAL'; ColunaPlanilha: 4),
      (Campo: 'DESCRICAODOPRODUTO'; ColunaPlanilha: 5),
      (Campo: 'ESPECIALIDADEPRODUTO'; ColunaPlanilha: 6),
      (Campo: 'CLASSIFICACAOPRODUTO'; ColunaPlanilha: 7),
      (Campo: 'NOMETECNICO'; ColunaPlanilha: 8),
      (Campo: 'UNIDMINFRACAO'; ColunaPlanilha: 9),
      (Campo: 'CNPJFABRICANTEIMPORTADOR'; ColunaPlanilha: 10),
      (Campo: 'DETENTORREGISTROANVISA'; ColunaPlanilha: 11),
      (Campo: 'REGISTROANVISA'; ColunaPlanilha: 12),
      (Campo: 'TAXADECUSTOS'; ColunaPlanilha: 13),
      (Campo: 'VALORMAXIMO'; ColunaPlanilha: 14),
      (Campo: 'OBSERVACOES'; ColunaPlanilha: 15),
      (Campo: 'TISSCODANTERIOR'; ColunaPlanilha: 16),
      (Campo: 'CODANTERIOR'; ColunaPlanilha: 17),
      (Campo: 'REFTAMANHOMODELO'; ColunaPlanilha: 18),
      (Campo: 'TIPODEPRODUTO'; ColunaPlanilha: 19),
      (Campo: 'TIPODECODIFICACAO'; ColunaPlanilha: 20),
      (Campo: 'DATAINICIOVIGENCIA'; ColunaPlanilha: 21),
      (Campo: 'DATAFIMVIGENCIA'; ColunaPlanilha: 22),
      (Campo: 'MOTIVODEINSERCAO'; ColunaPlanilha: 23),
      (Campo: 'DATAFIMIMPLANTACAO'; ColunaPlanilha: 24),
      (Campo: 'CODSIMPRO'; ColunaPlanilha: 25),
      (Campo: 'DESCRICAOPRODUTOSIMPRO'; ColunaPlanilha: 26),
      (Campo: 'EQUIVALENCIATECNICA'; ColunaPlanilha: 27)
    );
var
  XLApp, Sheet: OLEVariant;
  RangeMatrix: Variant;
  i, x, y, k, iTotLin, iRegGravados, iQtdGravar: Integer;
begin
  Result := False;
  XLApp := CreateOleObject('Excel.Application');
  try
 
    XLApp.Visible := False;
    XLApp.Workbooks.Open(XFileXLS);
 
    Sheet := XLApp.Workbooks[ExtractFileName(xFileXLS)].WorkSheets[1];
    Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;
 
    // obtém o número de linhas utilizadas
    iTotLin := Sheet.UsedRange.Rows.Count;
 
    x := XLApp.ActiveCell.Row;
    y := XLApp.ActiveCell.Column;
 
    RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value;
    k := 1;
    cdsmateriais.DisableControls;
 
    // indica qual o número total de iterações da barra de progresso
    ProgressBar1.Max := iTotLin;
    iQtdGravar := 300 // número de registros que serão gravados antes de reabrir o dataset
 
    try
      iRegGravados := 0;
      repeat
        // incrementa a barra de progresso
        ProgressBar1.StepIt;
 
        cdsmateriais.Append;
        for i := Low(MapaCampos) to High(MapaCampos) do
          cdsmateriais.FieldByName(MapaCampos[i].Campo).AsString := XLApp.cells[k,MapaCampos[i].ColunaPlanilha];
        cdsmateriais.Post;
 
        cdsmateriais.ApplyUpdates(0);
        Inc(k);
        Inc(iRegGravados);
 
        // atualiza a tela
        Application.processMessages;

	if iRegGravados >= iQtdGravar then
	begin
	  iRegGravados := 0; // zera o contador de registros
          cdsmateriais.Close; // fecha o dataset
          cdsmateriais.Open; // abre o dataset sem qualquer registro, liberando da memória os registros gravados até aqui
	end;
 
      until k > x;
 
    finally
      cdsmateriais.EnableControls;
    end
  finally
    if not VarIsEmpty(XLApp) then
    begin
      XLApp.WorkBooks.Close;
      XLApp.Quit;
      XLAPP := Unassigned;
      Sheet := Unassigned;
      Result := True;
      ShowMessage('Planilha importada com sucesso!');
    end;
  end;
end;


outra forma seria gravar o registro diretamente no banco, através de instrução SQL.

veja se a sugestão de fechar e reabrir o dataset funciona. se não funcionar, podemos tentar o segundo método.

GOSTEI 0
Vandeir

Vandeir

23/04/2020

Emerson fiz o teste aqui como vc disse, porém ainda continua dando esse erro "recursos de memória insuficientes disponíveis para concluir a operação",
o erro acontece quando vai carregar a planilha ele nem começa a importar, fiz o monitoramento pelo gerenciador de tarefas do windows, no momento em que o sistema começa a carregar, o excel usa muita memória ae nesse momento ocorre o erro. Mas separando as planilhas está funcionado perfeito. Mais uma vez, obrigado.


O problema deve ser porque o dataset está crescendo muito.
dependendo de como está teu dataset, você poderá fechá-lo e abri-lo quando alcançar um certo número de registros gravados.
coloque no teu dataset algo como: SELECT * FROM TABELA WHERE CAMPO = X, onde X é um valor que você sabe que NÃO retornará registros.
por exemplo:
SELECT * FROM CLIENTE WHERE CNPJ = 'A'

em teoria nunca será retornado um registro com a instrução acima, porque não há CNPJ com conteúdo 'A' (para o exemplo suponho que o campo seja alfanumérico).
desta forma, o dataset sempre virá vazio quando aberto.
então você coloca um contador e fecha o dataset quando alcançar um determinado número de registros.
esta forma é para que sejam feitas alterações mínimas no teu código.
ficaria assim:
function TfrmImporta.Xls_To_StringGrid(cdsmateriais: TClientDataSet;
xFileXLS: string): Boolean;
type
  TMapaCampo = record
    Campo: string;
    ColunaPlanilha: integer;
  end;
const
  xlCellTypeLastCell = $0000000B;
  MapaCampos: array[0..26] of TMapaCampo = (
      (Campo: 'CODIGOTISS'; ColunaPlanilha: 1),
      (Campo: 'TISSTPTABELA'; ColunaPlanilha: 2),
      (Campo: 'TISSCODMATERIAL'; ColunaPlanilha: 3),
      (Campo: 'NOMECOMERCIAL'; ColunaPlanilha: 4),
      (Campo: 'DESCRICAODOPRODUTO'; ColunaPlanilha: 5),
      (Campo: 'ESPECIALIDADEPRODUTO'; ColunaPlanilha: 6),
      (Campo: 'CLASSIFICACAOPRODUTO'; ColunaPlanilha: 7),
      (Campo: 'NOMETECNICO'; ColunaPlanilha: 8),
      (Campo: 'UNIDMINFRACAO'; ColunaPlanilha: 9),
      (Campo: 'CNPJFABRICANTEIMPORTADOR'; ColunaPlanilha: 10),
      (Campo: 'DETENTORREGISTROANVISA'; ColunaPlanilha: 11),
      (Campo: 'REGISTROANVISA'; ColunaPlanilha: 12),
      (Campo: 'TAXADECUSTOS'; ColunaPlanilha: 13),
      (Campo: 'VALORMAXIMO'; ColunaPlanilha: 14),
      (Campo: 'OBSERVACOES'; ColunaPlanilha: 15),
      (Campo: 'TISSCODANTERIOR'; ColunaPlanilha: 16),
      (Campo: 'CODANTERIOR'; ColunaPlanilha: 17),
      (Campo: 'REFTAMANHOMODELO'; ColunaPlanilha: 18),
      (Campo: 'TIPODEPRODUTO'; ColunaPlanilha: 19),
      (Campo: 'TIPODECODIFICACAO'; ColunaPlanilha: 20),
      (Campo: 'DATAINICIOVIGENCIA'; ColunaPlanilha: 21),
      (Campo: 'DATAFIMVIGENCIA'; ColunaPlanilha: 22),
      (Campo: 'MOTIVODEINSERCAO'; ColunaPlanilha: 23),
      (Campo: 'DATAFIMIMPLANTACAO'; ColunaPlanilha: 24),
      (Campo: 'CODSIMPRO'; ColunaPlanilha: 25),
      (Campo: 'DESCRICAOPRODUTOSIMPRO'; ColunaPlanilha: 26),
      (Campo: 'EQUIVALENCIATECNICA'; ColunaPlanilha: 27)
    );
var
  XLApp, Sheet: OLEVariant;
  RangeMatrix: Variant;
  i, x, y, k, iTotLin, iRegGravados, iQtdGravar: Integer;
begin
  Result := False;
  XLApp := CreateOleObject('Excel.Application');
  try
 
    XLApp.Visible := False;
    XLApp.Workbooks.Open(XFileXLS);
 
    Sheet := XLApp.Workbooks[ExtractFileName(xFileXLS)].WorkSheets[1];
    Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;
 
    // obtém o número de linhas utilizadas
    iTotLin := Sheet.UsedRange.Rows.Count;
 
    x := XLApp.ActiveCell.Row;
    y := XLApp.ActiveCell.Column;
 
    RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value;
    k := 1;
    cdsmateriais.DisableControls;
 
    // indica qual o número total de iterações da barra de progresso
    ProgressBar1.Max := iTotLin;
    iQtdGravar := 300 // número de registros que serão gravados antes de reabrir o dataset
 
    try
      iRegGravados := 0;
      repeat
        // incrementa a barra de progresso
        ProgressBar1.StepIt;
 
        cdsmateriais.Append;
        for i := Low(MapaCampos) to High(MapaCampos) do
          cdsmateriais.FieldByName(MapaCampos[i].Campo).AsString := XLApp.cells[k,MapaCampos[i].ColunaPlanilha];
        cdsmateriais.Post;
 
        cdsmateriais.ApplyUpdates(0);
        Inc(k);
        Inc(iRegGravados);
 
        // atualiza a tela
        Application.processMessages;

	if iRegGravados >= iQtdGravar then
	begin
	  iRegGravados := 0; // zera o contador de registros
          cdsmateriais.Close; // fecha o dataset
          cdsmateriais.Open; // abre o dataset sem qualquer registro, liberando da memória os registros gravados até aqui
	end;
 
      until k > x;
 
    finally
      cdsmateriais.EnableControls;
    end
  finally
    if not VarIsEmpty(XLApp) then
    begin
      XLApp.WorkBooks.Close;
      XLApp.Quit;
      XLAPP := Unassigned;
      Sheet := Unassigned;
      Result := True;
      ShowMessage('Planilha importada com sucesso!');
    end;
  end;
end;


outra forma seria gravar o registro diretamente no banco, através de instrução SQL.

veja se a sugestão de fechar e reabrir o dataset funciona. se não funcionar, podemos tentar o segundo método.

GOSTEI 0
Emerson Nascimento

Emerson Nascimento

23/04/2020

se o problema ocorre ao abrir a planilha, acredito que a solução que você utilizou seja mesmo a melhor.
ou então você pode utilizar um componente que abra a planilha diretamente, sem utilizar o Excel para isso.

GOSTEI 0
Vandeir

Vandeir

23/04/2020

Emerson, têm como incluir no código um label que fosse atualizando a quantidade de registros incluídos ou a porcentagem de registros incluídos?

O problema deve ser porque o dataset está crescendo muito.
dependendo de como está teu dataset, você poderá fechá-lo e abri-lo quando alcançar um certo número de registros gravados.
coloque no teu dataset algo como: SELECT * FROM TABELA WHERE CAMPO = X, onde X é um valor que você sabe que NÃO retornará registros.
por exemplo:
SELECT * FROM CLIENTE WHERE CNPJ = 'A'

em teoria nunca será retornado um registro com a instrução acima, porque não há CNPJ com conteúdo 'A' (para o exemplo suponho que o campo seja alfanumérico).
desta forma, o dataset sempre virá vazio quando aberto.
então você coloca um contador e fecha o dataset quando alcançar um determinado número de registros.
esta forma é para que sejam feitas alterações mínimas no teu código.
ficaria assim:
function TfrmImporta.Xls_To_StringGrid(cdsmateriais: TClientDataSet;
xFileXLS: string): Boolean;
type
  TMapaCampo = record
    Campo: string;
    ColunaPlanilha: integer;
  end;
const
  xlCellTypeLastCell = $0000000B;
  MapaCampos: array[0..26] of TMapaCampo = (
      (Campo: 'CODIGOTISS'; ColunaPlanilha: 1),
      (Campo: 'TISSTPTABELA'; ColunaPlanilha: 2),
      (Campo: 'TISSCODMATERIAL'; ColunaPlanilha: 3),
      (Campo: 'NOMECOMERCIAL'; ColunaPlanilha: 4),
      (Campo: 'DESCRICAODOPRODUTO'; ColunaPlanilha: 5),
      (Campo: 'ESPECIALIDADEPRODUTO'; ColunaPlanilha: 6),
      (Campo: 'CLASSIFICACAOPRODUTO'; ColunaPlanilha: 7),
      (Campo: 'NOMETECNICO'; ColunaPlanilha: 8),
      (Campo: 'UNIDMINFRACAO'; ColunaPlanilha: 9),
      (Campo: 'CNPJFABRICANTEIMPORTADOR'; ColunaPlanilha: 10),
      (Campo: 'DETENTORREGISTROANVISA'; ColunaPlanilha: 11),
      (Campo: 'REGISTROANVISA'; ColunaPlanilha: 12),
      (Campo: 'TAXADECUSTOS'; ColunaPlanilha: 13),
      (Campo: 'VALORMAXIMO'; ColunaPlanilha: 14),
      (Campo: 'OBSERVACOES'; ColunaPlanilha: 15),
      (Campo: 'TISSCODANTERIOR'; ColunaPlanilha: 16),
      (Campo: 'CODANTERIOR'; ColunaPlanilha: 17),
      (Campo: 'REFTAMANHOMODELO'; ColunaPlanilha: 18),
      (Campo: 'TIPODEPRODUTO'; ColunaPlanilha: 19),
      (Campo: 'TIPODECODIFICACAO'; ColunaPlanilha: 20),
      (Campo: 'DATAINICIOVIGENCIA'; ColunaPlanilha: 21),
      (Campo: 'DATAFIMVIGENCIA'; ColunaPlanilha: 22),
      (Campo: 'MOTIVODEINSERCAO'; ColunaPlanilha: 23),
      (Campo: 'DATAFIMIMPLANTACAO'; ColunaPlanilha: 24),
      (Campo: 'CODSIMPRO'; ColunaPlanilha: 25),
      (Campo: 'DESCRICAOPRODUTOSIMPRO'; ColunaPlanilha: 26),
      (Campo: 'EQUIVALENCIATECNICA'; ColunaPlanilha: 27)
    );
var
  XLApp, Sheet: OLEVariant;
  RangeMatrix: Variant;
  i, x, y, k, iTotLin, iRegGravados, iQtdGravar: Integer;
begin
  Result := False;
  XLApp := CreateOleObject('Excel.Application');
  try
 
    XLApp.Visible := False;
    XLApp.Workbooks.Open(XFileXLS);
 
    Sheet := XLApp.Workbooks[ExtractFileName(xFileXLS)].WorkSheets[1];
    Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;
 
    // obtém o número de linhas utilizadas
    iTotLin := Sheet.UsedRange.Rows.Count;
 
    x := XLApp.ActiveCell.Row;
    y := XLApp.ActiveCell.Column;
 
    RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value;
    k := 1;
    cdsmateriais.DisableControls;
 
    // indica qual o número total de iterações da barra de progresso
    ProgressBar1.Max := iTotLin;
    iQtdGravar := 300 // número de registros que serão gravados antes de reabrir o dataset
 
    try
      iRegGravados := 0;
      repeat
        // incrementa a barra de progresso
        ProgressBar1.StepIt;
 
        cdsmateriais.Append;
        for i := Low(MapaCampos) to High(MapaCampos) do
          cdsmateriais.FieldByName(MapaCampos[i].Campo).AsString := XLApp.cells[k,MapaCampos[i].ColunaPlanilha];
        cdsmateriais.Post;
 
        cdsmateriais.ApplyUpdates(0);
        Inc(k);
        Inc(iRegGravados);
 
        // atualiza a tela
        Application.processMessages;

	if iRegGravados >= iQtdGravar then
	begin
	  iRegGravados := 0; // zera o contador de registros
          cdsmateriais.Close; // fecha o dataset
          cdsmateriais.Open; // abre o dataset sem qualquer registro, liberando da memória os registros gravados até aqui
	end;
 
      until k > x;
 
    finally
      cdsmateriais.EnableControls;
    end
  finally
    if not VarIsEmpty(XLApp) then
    begin
      XLApp.WorkBooks.Close;
      XLApp.Quit;
      XLAPP := Unassigned;
      Sheet := Unassigned;
      Result := True;
      ShowMessage('Planilha importada com sucesso!');
    end;
  end;
end;


outra forma seria gravar o registro diretamente no banco, através de instrução SQL.

veja se a sugestão de fechar e reabrir o dataset funciona. se não funcionar, podemos tentar o segundo método.

GOSTEI 0
Emerson Nascimento

Emerson Nascimento

23/04/2020

você pode colocar uma label na tela e atualiza-la no mesmo momento que atualiza a barra de progresso.
function TfrmImporta.Xls_To_StringGrid(cdsmateriais: TClientDataSet;
xFileXLS: string): Boolean;
type
  TMapaCampo = record
    Campo: string;
    ColunaPlanilha: integer;
  end;
const
  xlCellTypeLastCell = $0000000B;
  MapaCampos: array[0..26] of TMapaCampo = (
      (Campo: 'CODIGOTISS'; ColunaPlanilha: 1),
      (Campo: 'TISSTPTABELA'; ColunaPlanilha: 2),
      (Campo: 'TISSCODMATERIAL'; ColunaPlanilha: 3),
      (Campo: 'NOMECOMERCIAL'; ColunaPlanilha: 4),
      (Campo: 'DESCRICAODOPRODUTO'; ColunaPlanilha: 5),
      (Campo: 'ESPECIALIDADEPRODUTO'; ColunaPlanilha: 6),
      (Campo: 'CLASSIFICACAOPRODUTO'; ColunaPlanilha: 7),
      (Campo: 'NOMETECNICO'; ColunaPlanilha: 8),
      (Campo: 'UNIDMINFRACAO'; ColunaPlanilha: 9),
      (Campo: 'CNPJFABRICANTEIMPORTADOR'; ColunaPlanilha: 10),
      (Campo: 'DETENTORREGISTROANVISA'; ColunaPlanilha: 11),
      (Campo: 'REGISTROANVISA'; ColunaPlanilha: 12),
      (Campo: 'TAXADECUSTOS'; ColunaPlanilha: 13),
      (Campo: 'VALORMAXIMO'; ColunaPlanilha: 14),
      (Campo: 'OBSERVACOES'; ColunaPlanilha: 15),
      (Campo: 'TISSCODANTERIOR'; ColunaPlanilha: 16),
      (Campo: 'CODANTERIOR'; ColunaPlanilha: 17),
      (Campo: 'REFTAMANHOMODELO'; ColunaPlanilha: 18),
      (Campo: 'TIPODEPRODUTO'; ColunaPlanilha: 19),
      (Campo: 'TIPODECODIFICACAO'; ColunaPlanilha: 20),
      (Campo: 'DATAINICIOVIGENCIA'; ColunaPlanilha: 21),
      (Campo: 'DATAFIMVIGENCIA'; ColunaPlanilha: 22),
      (Campo: 'MOTIVODEINSERCAO'; ColunaPlanilha: 23),
      (Campo: 'DATAFIMIMPLANTACAO'; ColunaPlanilha: 24),
      (Campo: 'CODSIMPRO'; ColunaPlanilha: 25),
      (Campo: 'DESCRICAOPRODUTOSIMPRO'; ColunaPlanilha: 26),
      (Campo: 'EQUIVALENCIATECNICA'; ColunaPlanilha: 27)
    );
var
  XLApp, Sheet: OLEVariant;
  RangeMatrix: Variant;
  i, x, y, k, iTotLin: Integer;
  iLenTotal: integer;
  strTotal, strFmtLabel: string;
begin
  Result := False;
  XLApp := CreateOleObject('Excel.Application');
  try
  
    XLApp.Visible := False;
    XLApp.Workbooks.Open(XFileXLS);
  
    Sheet := XLApp.Workbooks[ExtractFileName(xFileXLS)].WorkSheets[1];
    Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;
  
    // obtém o número de linhas utilizadas
    iTotLin := Sheet.UsedRange.Rows.Count;
  
    x := XLApp.ActiveCell.Row;
    y := XLApp.ActiveCell.Column;
  
    RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value;
    k := 1;
    cdsmateriais.DisableControls;
  
    // configura a barra de progresso
    ProgressBar1.Step := 1; // incremento de StepIt
    ProgressBar1.Min := 0;
    ProgressBar1.Max := iTotLin;
    // valores para trabalho com a label
    strTotal := Trim(IntToStr(ProgressBar1.Max));
    iLenTotal := Length(strTotal);
    strFmtLabel := StringOfChar('0',iLenTotal);
    // configura a label para apresentação do progresso (será apresentado no formato 'n/total')
    LabelProgresso.Alignment := taRightJustify;
    LabelProgresso.AutoSize := False;
    LabelProgresso.Caption := FormatFloat(strFmtLabel, ProgressBar1.Position)+'/'+strTotal;

    try
      repeat
        // incrementa a barra de progresso e atualiza a label
        ProgressBar1.StepIt;
        LabelProgresso.Caption := FormatFloat(strFmtLabel, ProgressBar1.Position)+'/'+strTotal;

        cdsmateriais.Append;
        for i := Low(MapaCampos) to High(MapaCampos) do
          cdsmateriais.FieldByName(MapaCampos[i].Campo).AsString := XLApp.cells[k,MapaCampos[i].ColunaPlanilha];
        cdsmateriais.Post;
  
        cdsmateriais.ApplyUpdates(0);
        Inc(k);
  
        // atualiza a tela
        Application.processMessages;

      until k > x;
  
    finally
      cdsmateriais.EnableControls;
    end
  finally
    if not VarIsEmpty(XLApp) then
    begin
      XLApp.WorkBooks.Close;
      XLApp.Quit;
      XLAPP := Unassigned;
      Sheet := Unassigned;
      Result := True;
      ShowMessage('Planilha importada com sucesso!');
    end;
  end;
end;

ou pode trocar a ProgressBar por uma Gauge. com a Gauge você poderá apresentar o percentual ao colocar a propriedade ShowText como True e ainda utilizar a label como descrito acima.

GOSTEI 0
Vandeir

Vandeir

23/04/2020

Eu troquei pelo Gauge, deu certinho, funcionado perfeito. Obrigado Emerson.


você pode colocar uma label na tela e atualiza-la no mesmo momento que atualiza a barra de progresso.
function TfrmImporta.Xls_To_StringGrid(cdsmateriais: TClientDataSet;
xFileXLS: string): Boolean;
type
  TMapaCampo = record
    Campo: string;
    ColunaPlanilha: integer;
  end;
const
  xlCellTypeLastCell = $0000000B;
  MapaCampos: array[0..26] of TMapaCampo = (
      (Campo: 'CODIGOTISS'; ColunaPlanilha: 1),
      (Campo: 'TISSTPTABELA'; ColunaPlanilha: 2),
      (Campo: 'TISSCODMATERIAL'; ColunaPlanilha: 3),
      (Campo: 'NOMECOMERCIAL'; ColunaPlanilha: 4),
      (Campo: 'DESCRICAODOPRODUTO'; ColunaPlanilha: 5),
      (Campo: 'ESPECIALIDADEPRODUTO'; ColunaPlanilha: 6),
      (Campo: 'CLASSIFICACAOPRODUTO'; ColunaPlanilha: 7),
      (Campo: 'NOMETECNICO'; ColunaPlanilha: 8),
      (Campo: 'UNIDMINFRACAO'; ColunaPlanilha: 9),
      (Campo: 'CNPJFABRICANTEIMPORTADOR'; ColunaPlanilha: 10),
      (Campo: 'DETENTORREGISTROANVISA'; ColunaPlanilha: 11),
      (Campo: 'REGISTROANVISA'; ColunaPlanilha: 12),
      (Campo: 'TAXADECUSTOS'; ColunaPlanilha: 13),
      (Campo: 'VALORMAXIMO'; ColunaPlanilha: 14),
      (Campo: 'OBSERVACOES'; ColunaPlanilha: 15),
      (Campo: 'TISSCODANTERIOR'; ColunaPlanilha: 16),
      (Campo: 'CODANTERIOR'; ColunaPlanilha: 17),
      (Campo: 'REFTAMANHOMODELO'; ColunaPlanilha: 18),
      (Campo: 'TIPODEPRODUTO'; ColunaPlanilha: 19),
      (Campo: 'TIPODECODIFICACAO'; ColunaPlanilha: 20),
      (Campo: 'DATAINICIOVIGENCIA'; ColunaPlanilha: 21),
      (Campo: 'DATAFIMVIGENCIA'; ColunaPlanilha: 22),
      (Campo: 'MOTIVODEINSERCAO'; ColunaPlanilha: 23),
      (Campo: 'DATAFIMIMPLANTACAO'; ColunaPlanilha: 24),
      (Campo: 'CODSIMPRO'; ColunaPlanilha: 25),
      (Campo: 'DESCRICAOPRODUTOSIMPRO'; ColunaPlanilha: 26),
      (Campo: 'EQUIVALENCIATECNICA'; ColunaPlanilha: 27)
    );
var
  XLApp, Sheet: OLEVariant;
  RangeMatrix: Variant;
  i, x, y, k, iTotLin: Integer;
  iLenTotal: integer;
  strTotal, strFmtLabel: string;
begin
  Result := False;
  XLApp := CreateOleObject('Excel.Application');
  try
  
    XLApp.Visible := False;
    XLApp.Workbooks.Open(XFileXLS);
  
    Sheet := XLApp.Workbooks[ExtractFileName(xFileXLS)].WorkSheets[1];
    Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;
  
    // obtém o número de linhas utilizadas
    iTotLin := Sheet.UsedRange.Rows.Count;
  
    x := XLApp.ActiveCell.Row;
    y := XLApp.ActiveCell.Column;
  
    RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value;
    k := 1;
    cdsmateriais.DisableControls;
  
    // configura a barra de progresso
    ProgressBar1.Step := 1; // incremento de StepIt
    ProgressBar1.Min := 0;
    ProgressBar1.Max := iTotLin;
    // valores para trabalho com a label
    strTotal := Trim(IntToStr(ProgressBar1.Max));
    iLenTotal := Length(strTotal);
    strFmtLabel := StringOfChar('0',iLenTotal);
    // configura a label para apresentação do progresso (será apresentado no formato 'n/total')
    LabelProgresso.Alignment := taRightJustify;
    LabelProgresso.AutoSize := False;
    LabelProgresso.Caption := FormatFloat(strFmtLabel, ProgressBar1.Position)+'/'+strTotal;

    try
      repeat
        // incrementa a barra de progresso e atualiza a label
        ProgressBar1.StepIt;
        LabelProgresso.Caption := FormatFloat(strFmtLabel, ProgressBar1.Position)+'/'+strTotal;

        cdsmateriais.Append;
        for i := Low(MapaCampos) to High(MapaCampos) do
          cdsmateriais.FieldByName(MapaCampos[i].Campo).AsString := XLApp.cells[k,MapaCampos[i].ColunaPlanilha];
        cdsmateriais.Post;
  
        cdsmateriais.ApplyUpdates(0);
        Inc(k);
  
        // atualiza a tela
        Application.processMessages;

      until k > x;
  
    finally
      cdsmateriais.EnableControls;
    end
  finally
    if not VarIsEmpty(XLApp) then
    begin
      XLApp.WorkBooks.Close;
      XLApp.Quit;
      XLAPP := Unassigned;
      Sheet := Unassigned;
      Result := True;
      ShowMessage('Planilha importada com sucesso!');
    end;
  end;
end;

ou pode trocar a ProgressBar por uma Gauge. com a Gauge você poderá apresentar o percentual ao colocar a propriedade ShowText como True e ainda utilizar a label como descrito acima.

GOSTEI 0
POSTAR