Ver Mensaje Individual
  #8  
Antiguo 21-05-2004
Avatar de weke
weke weke is offline
Miembro
 
Registrado: may 2004
Ubicación: Valencia
Posts: 170
Reputación: 21
weke Va por buen camino
Thumbs up Solucion

Pues aqui os pongo el código de como lo he hecho.
EXPORTAR:
Código:
 
procedure TF_Export_Import.ExportarClick(Sender: TObject);
var
  Excel : Variant;
  fichero,temp : String;
  i,j : integer;
  creado:boolean;
  Tarj : FRMXTarjeta;
  l1 : TListItem;
begin
  Confirmar.Enabled:=false;
  i:=0;
  j:=0;
  creado:=false;
//***** Rellenamos el listview con los datos *****//
  ListView1.Items.Clear;
  Instalacion.coleccion_tarjetas.inicio;
  While not Instalacion.coleccion_tarjetas.es_fin do begin
	Tarj:=Instalacion.coleccion_tarjetas.get_element();
	l1:=ListView1.Items.Add;
	l1.Caption:=inttostr(ListView1.Items.Count);
	l1.SubItems.Add(Tarj.get_codigo_tarjeta);
	l1.SubItems.Add(Tarj.usuario_duenyo.get_nombre);
	l1.SubItems.Add(Tarj.usuario_duenyo.get_apellidos);
	Instalacion.coleccion_tarjetas.siguiente;
  end;//fin mientras
//***** CREAMOS EL OBJETO EXCEL *****//
  try
  begin
	Excel := CreateOLEObject('Excel.Application');
	Excel.WorkBooks.Add;
	creado:=true;
  end;
  except
  begin
	Excel.Quit;
	showmessage('No se pudo crear el Objecto Excel o se produjo algún error.');
	raise;
  end;
  end;  //fin try
//***** RECORREMOS EL LISTVIEW E INSERTAMOS LOS DATOS EN EL OBJETO EXCEL *****//
  Excel.Cells[1,1].Value:='"Codigo Tarjeta"';
  Excel.Cells[1,2].Value:='"Nombre"';
  Excel.Cells[1,3].Value:='"Apellidos"';
  while (i < ListView1.Items.Count) do
  begin
	while (j < 3) do
	begin
	  try
	  begin
		  //***** Acceso a las celdas *****//
		Excel.Cells[i+2,j+1].Value:=ListView1.Items[i].SubItems.strings[j];
		j:=j+1;
	  end;
	  except
	  begin
		Excel.Quit;
		creado:=false;
		raise;
	  end;
	  end;
	end;
	i:=i+1;
	j:=0;
  end;  //fin while
//***** GUARDAMOS EL OBJETO EXCEL *****//
  if (creado = true) then
	try
	begin
	  Excel.Save;
	end;
	except
	begin
	  Excel.Quit;
	  raise;
	end;
	end;  //fin try
  Excel.Quit;
 
  Limpiar.Enabled:=true;
end;
IMPORTAR
Código:
  
procedure TF_Export_Import.ImportarClick(Sender: TObject);
var
  Excel : Variant;
  i : integer;
  l1 : TListItem;
  filename : string;
  lineas : integer;
begin
  i:=2;
  open.FileName:='';
  open.Execute;
  filename:=open.FileName;
  if filename <> '' then
  begin
//***** Creamos el Objeto Ole *****//
	try
	  Excel := CreateOleObject('Excel.Application');
	except
	  Excel.Quit;
	  showmessage('No se pudo crear el Objecto Excel o se produjo algún error.');
	  raise;
	end;
//***** Asignamos el archivo a abrir *****//
	Excel.Workbooks.Open(filename);
//***** Limpiamos la lista *****//
	listview1.Items.Clear;
//***** Obtenemos la ultima linea del archivo excel *****//
	try
	begin
	  Excel.Selection.End[xlDown].Select;
	  lineas := Excel.ActiveCell.Row;
	  Excel.Selection.End[xlUp].Select;
	end;
	except
	begin
	  ShowMessage('No se ha podido localizar la última línea del archivo.');
	  raise;
	end;
	end;
//***** Llenamos el ListView con los datos del archivo excel *****//
	while (i <= lineas) do  //Excel.ActiveCell.Row te calcula la ultima línea del archivo
	begin
		//ShowMessage(inttostr(Excel.ActiveCell.Row));
		//***** Acceso a los datos de las celdas *****//
		L1:=ListView1.Items.Add;
		L1.Caption:=inttostr(ListView1.Items.Count);
		L1.SubItems.Add(Excel.Cells[i,1].Value);
		L1.SubItems.Add(Excel.Cells[i,2].Value);
		L1.SubItems.Add(Excel.Cells[i,3].Value);
		i:=i+1;
	end;
//***** Cerramos el Excel *****//
	  Excel.quit;
	  Confirmar.Enabled:=true;
	  Limpiar.Enabled:=true;
  end;
end;
Espero que os pueda ayudar. Un saludo.
__________________
De lo bueno lo mejor, de lo mejor lo superior.
Responder Con Cita