Witam,
jak przechwycić zdarzenie ANULUJ Gdy program pyta czy nadpisać plik?
Ponieważ u mnie wyskakuje po tym błąd
Metoda SaveAs z klasy Workbook nie powiodła się.
if OpenDialog1.Execute then
begin
...
end;
procedure TPrzeglad_czynnosci_podczas_pracy.EksportClick(Sender: TObject);
begin
if DBGrid1.Columns[0].Field.Value=NULL then
MessageBox(Handle,'Brak danych!', 'U W A G A!', MB_OK + MB_ICONSTOP)
else
begin
saveDialog1 := TSaveDialog.Create(self);
saveDialog1.Title := 'Zapis danych';
SaveDialog1.Filter := 'Excel File|*.xls|Excel File |*.xlsx|';
if SaveDialog1.Execute then
begin
Pasek_laduj.Show;
SaveToExcelFile(SaveDialog1.FileName);
MessageBox(Handle,'Zapis zakończony powodzeniem', 'U W A G A!', MB_OK + MB_ICONINFORMATION);
Pasek_laduj.Close;
end
else
begin
MessageBox(Handle,'Zapis zakończony niepowodzeniem', 'U W A G A!', MB_OK + MB_ICONSTOP);
end;
saveDialog1.Free;
end;
Niezbyt bo program najpierw pyta o lokalizacje pliku wybieram plik, który istnieje.
Następnie przechodzi mi po danych i po tym wszystkich pyta czy nadpisać.
Jak dam tak to działa, jak anuluj wyskakuje błąd.
Nie jestem pewien czy o to Ci chodzi ale poniżej w pełni działający kod, który zapisuje blob z bazy do pliku
procedure TfmRejestrWydr.bF3Click(Sender: TObject);
var
MemStm: TMemoryStream;
Stm: TStream;
begin
inherited;
if not bF3.Enabled or not bF3.Visible then
Exit;
try
dlgSave.Filename := qRWD.FieldByName('FRNAME').AsString;
if qRWD.FieldByName('FRPL').IsNull then
begin
MessageDlg('Brak pliku szablonu.', mtWarning, [mbOK], 0);
Exit;
end
else
if dlgSave.Execute then
if dlgSave.FileName <> '' then
begin
MemStm := TMemoryStream.Create;
Stm := TStream.Create;
Stm := qRWD.CreateBlobStream(qRWD.FieldByName('FRPL'),bmRead);
Stm.Position := 0;
MemStm.CopyFrom(Stm,Stm.Size);
MemStm.SaveToFile(dlgSave.FileName);
if FileExists(dlgSave.FileName) then
begin
ChangeFileExt(dlgSave.FileName,'.txt');
MessageDlg('Szablon zapisany w :'+ ExtractFilePath(dlgSave.FileName), mtInformation, [mbOK], 0);
end;
end;
finally
MemStm.Free;
Stm.Free;
end;
end;
@Kazik1 - poniżej umieszczam Twój kod, tyle że przerobiony i sformatowany; Pozwala on na poprawne wykrycie anulowania okna dialogowego i odpowiednie zareagowanie:
procedure TPrzeglad_czynnosci_podczas_pracy.EksportClick(Sender: TObject);
begin
if DBGrid1.Columns[0].Field.Value = NULL then
MessageBox(Handle,'Brak danych!', 'U W A G A!', MB_OK + MB_ICONSTOP)
else
with TSaveDialog.Create(Self) do
try
Title := 'Zapis danych';
Filter := 'Excel File|*.xls|Excel File |*.xlsx|';
if Execute() then
begin
Pasek_laduj.Show();
SaveToExcelFile(FileName);
MessageBox(Handle,'Zapis zakończony powodzeniem', 'U W A G A!', MB_OK + MB_ICONINFORMATION);
Pasek_laduj.Close();
end
else
MessageBox(Handle, 'Zapis anulowany', 'U W A G A!', MB_OK + MB_ICONSTOP);
finally
Free();
end;
end;
Jeżeli medota Execute
zwróci True, czyli plik zostanie wybrany z dysku lub zostanie podana poprawna jego nazwa - wykonany zostanie zapis; Jeżeli okno zostanie zamknięte krzyżykiem lub przyciskiem Anuluj
- pokaże się jedynie komunikat o anulowaniu zapisu i nic więcej; Jeżeli nadal dzieją się dziwne rzeczy, to na pewno nie w tej metodzie;
Tak przy okazji - wyświetlanie komunikatu o anulowaniu zapisu jest raczej zbędne.
Dalej pokazuje błąd.
Niestety nie wiem dlaczego tak się dzieje..
Mogłbym dodać:
Excel.DisplayAlerts := False;
Ale chciałbym aby przed zapisem spytało czy nadpisać.
Mógłby ktoś podpowiedzieć dlaczego taki błąd?
procedure TPrzeglad_czynnosci_podczas_pracy.SaveToExcelFile(const AFileName: TFileName);
const
Worksheet = -4167;
var
Row, Col: Integer;
Excel, Sheet, Data: OLEVariant;
I, J, DataCols, DataRows: Integer;
begin
DataCols := ClientDataset1.FieldCount;
DataRows := ClientDataset1.RecordCount + 1; //1 for the title
Data := VarArrayCreate([1, DataRows, 1, DataCols], varVariant);
for I := 0 to DataCols - 1 do
Data[1, I+1] := ClientDataset1.Fields[I].FieldName;
J := 1;
ClientDataset1.First;
while (not ClientDataset1.Eof) and (J < DataRows) do
begin
for I := 0 to DataCols - 1 do
Data[J + 1, I + 1] := ClientDataset1.Fields[I].Value;
Inc(J);
ClientDataset1.Next;
end;
Excel := CreateOleObject('Excel.Application');
try
Excel.Visible := False;
Excel.Workbooks.Add(Worksheet);
Sheet := Excel.Workbooks[1].WorkSheets[1];
Sheet.Name := 'Sheet1';
Sheet.Range[RefToCell(1, 1), RefToCell(DataRows, DataCols)].Value := Data;
try
Excel.Workbooks[1].SaveAs(AFileName);
except
on E: Exception do
raise Exception.Create('Data transfer error: ' + E.Message);
end;
finally
if not VarIsEmpty(Excel) then
begin
Excel.DisplayAlerts := False;
Excel.Quit;
Excel := Unassigned;
Sheet := Unassigned;
end;
end;
end;
No to po co wywołujesz ponownie wyjątek?
try
Excel.Workbooks[1].SaveAs(AFileName);
except
on E: Exception do
raise Exception.Create('Data transfer error: ' + E.Message);
end;
Zmień na:
try
Excel.Workbooks[1].SaveAs(AFileName);
except
//tu nic nie trzeba robić
end;
Teraz niby dalej będzie pokazywało wyjątek ale tylko podczas debugowania w środowisku Delphi.
Jeśli skorzystasz z drugiego przykładu jaki podał poprzednik, to ewentualnie możesz pomiędzy Except a End wstawić samo Raise, dzięki czemu wyjątek zostanie puszczony do procedury nadrzędnej; Ale to tylko w przypadku, gdy ten wyjątek potrzebujesz puścić dalej i w jakiejś procedurze nadrzędnej go obsłużyć;
W innych przypadkach nie musisz stosować Raise, a nawet całego bloku Try Except, jeżeli w ogóle nie będziesz obsługiwać wyjątku; Wtedy wyjątek poleci, przerwie daną procedurę/metodę i tyle; Z bloków zabezpieczających korzystaj tylko wtedy, gdy to ma sens, a nie wszędzie gdzie popadnie.