ExportAsFixedFormat's IgnorePrintAreas parameter seems not to have effect - delphi

In a Delphi application I am using since years the following code to export xlxs to pdf:
function TExportTool.ExportExcelToPDF(aFileName, aNewFileName: String): Boolean;
// reference : http://embarcadero.newsgroups.archived.at/public.delphi.oleautomation/200811/081103142.html
// unluckily the link above is dead
{- Sheet is counted from 1 and upwards !! }
Var
App,oWB,oSheet : OleVariant;
begin
Result := False;
App:= CreateOleObject('Excel.Application');
Try
App.Visible:= 0;
oWb := App.WorkBooks.Open(ExpandUNCFileName(afilename),1); // Open read only
Try
oSheet := oWB.ActiveSheet;
oSheet.ExportAsFixedFormat(0, //xlTypePDF is constant 0
aNewFileName,
EmptyParam,
EmptyParam,
EmptyParam, // this should be IgnorePrintAreas
EmptyParam,
EmptyParam,
EmptyParam,
EmptyParam
);
Finally
End;
Result := True;
Finally
App.Quit;
App:= UnAssigned;
End;
end;
// IMPROVED WORKING CODE FOLLOWS
function TExportTool.ExportExcelToPDF(aFileName, aNewFileName: String): Boolean;
// reference : http://embarcadero.newsgroups.archived.at/public.delphi.oleautomation/200811/081103142.html
{- Sheet is counted from 1 and upwards !! }
procedure RestoreOriginalPrintArea (oSheet: OleVariant);
// Excel loses print area settings in non-English version of application when file is opened using automation:
// https://stackoverflow.com/questions/71379893/exportasfixedformats-ignoreprintareas-parameter-seems-not-to-have-effect
var
i:Integer;
begin
for i:= 1 to oSheet.Names.Count do
begin
if VarToStr(oSheet.Names.Item(i).Name).EndsWith('!Print_Area') then
begin
oSheet.PageSetup.PrintArea:='Print_area';
Break;
end;
end;
end;
Var
App,oWB,oSheet : OleVariant;
i:Integer;
begin
Result := False;
App:= CreateOleObject('Excel.Application');
Try
App.Visible:= 0;
oWb := App.WorkBooks.Open(ExpandUNCFileName(afilename),1); // Open read only
Try
oSheet := oWB.ActiveSheet;
RestoreOriginalPrintArea(oSheet); // workaround
oSheet.ExportAsFixedFormat(0, //xlTypePDF is constant 0
aNewFileName,
0, // standard quality = 0, Max quality = 1
false, //include doc properties
false, //ignore print area
EmptyParam,
EmptyParam,
EmptyParam,
EmptyParam
);
Finally
End;
Result := True;
Finally
oWB.Close(false); // better to close the WorkBook too
App.Quit;
App:= UnAssigned;
End;
end;
Now i realized that the pdf created with this code behave like when saving to pdf from Excel using the option "Ignore Print areas" (it is one of the options of the export to pdf from Excel feature).
So I decided to "uncheck" that checkbox also from code and I studied the parameters of ExportAsFixedFormat (reference here).
The fifth parameter is IgnorePrintAreas, so I was assuming that passing False to it, the print areas would have been ignored.
I tried several common sense solution, including:
passing only that parameter (passing either True or False )
passing all the first 5 parameters (just in case they are mandatory at runtime)
but no result: the pdf created by my application still "ignores the print areas".
Does anyone has a suggestion or has experience on this specific subject to give me a pointer to fix this issue?
Thanks.
UPDATE
Thanks to the useful accepted answer I appended to the code above the solution for reference, notice two things:
the RestoreOriginalPrintArea procedure that contains the workaround
the call to oWB.Close(false) at the end

Root cause of error:
Excel loses print area settings in non-English version of application when file is opened using automation.
Why this is happening:
When you define print area in a sheet, Excel internally creates a named range. It has two properties defining its name:
Name this property is always of the form WorksheetsName!Print_Area (if the sheet's name contains some special characters it is also enclosed in single quotes).
NameLocal has similar structure, but the second part is translated into the language of the application.
This is what it looks like when you open the file in Excel and inspect these properties in VBA, but when you open the same file using automation (for example using the code in question), then NameLocal is no longer translated. This bug causes the named range to not be recognized correctly as print area. oSheet.PageSetup.PrintArea returns an empty string.
Workaround:
Restore original print area after opening the file using:
oSheet.PageSetup.PrintArea:='Print_Area';
This line of code will throw an exception when there was no print area defined in sheet, so there are two options:
Place the line inside try..except block.
Iterate the Names collection and look for a Name ending with !Print_Area, for example:
var i:Integer;
for i:= 1 to oSheet.Names.Count do
begin
if VarToStr(oSheet.Names.Item(i).Name).EndsWith('!Print_Area') then
begin
oSheet.PageSetup.PrintArea:='Print_area';
Break;
end;
end;
Other important change:
Because the file could have been modified you also need to add:
oWB.Close(false); //do not save changes
before closing the application, otherwise each call to this function would result in another Excel process still running invisible.

Related

How to correctly use IFileOperation in Delphi to delete the files in a folder

I'm trying to create a simple example of using IFileOperation to delete the files in a
given directory, to include in the answer to another q for comparison with other methods.
Below is the code of my MRE. It
successfully creates 1000 files in a subdirectory off C:\Temp and then attempts to delete
them in the DeleteFiles method. This supposedly "easy" task fails but I'm not sure
exactly where it comes off the rails. The comments in the code show what I'm expecting
and the actual results. On one occasion, instead of the exception noted, I got a pop-up
asking for confirmation to delete an item with an odd name which was evidently an array of
numbers referring to a shell item, but my attempt to capture it using Ctrl-C failed;
I'm fairly sure I'm either missing a step or two, misusing the interfaces involved
or both. My q is, could anybody please show the necessary corrections to the code to get IFileOperation.DeleteItems() to delete the files in question, as I am completely out of my depth with this stuff? I am not interested in alternative methods of deleting these files, using the shell interfaces or otherwise.
procedure TForm2.DeleteFiles;
var
iFileOp: IFileOperation;
iIDList : ItemIDList;
iItemArray : IShellItemArray;
iArray : Array[0..1] of ItemIDList;
Count : DWord;
begin
iFileOp := CreateComObject(CLSID_FileOperation) as IFileOperation;
iIDList := ILCreateFromPath(sPath)^;
// IFileOperation.DeleteItems seems to require am IShellItemArray, so the following attempts
// to create one
// The definition of SHCreateShellItemArrayFromIDLists
// seems to require a a zero-terminated array of ItemIDLists so the next steps
// attempt to create one
ZeroMemory(#iArray, SizeOf(iArray));
iArray[0] := iIDList;
OleCheck(SHCreateShellItemArrayFromIDLists(1, #iArray, iItemArray));
// Next test the number of items in iItemArray, which I'm expecting to be 1000
// seeing as the CreateFiles routine creats that many
OleCheck(iItemArray.GetCount(Count));
Caption := IntToStr(Count); // Duh, this shows Count to be 1, not the expected 1000
OleCheck(iFileOp.DeleteItems(iItemArray));
OleCheck( iFileOp.PerformOperations );
// Returns Exception 'No object for moniker'
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
DeleteFiles;
end;
procedure CreateFiles;
var
i : Integer;
SL : TStringList;
FileName,
FileContent : String;
begin
SL := TStringList.Create;
try
if not (DirectoryExists(sPath)) then
MkDir(sPath);
SL.BeginUpdate;
for i := 0 to 999 do begin
FileName := Format('File%d.Txt', [i]);
FileContent := Format('content of file %s', [FileName]);
SL.Text := FileContent;
SL.SaveToFile(sPath + '\' + FileName);
end;
SL.EndUpdate;
finally
SL.Free;
end;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
CreateFiles;
end;
You are leaking the memory returned by ILCreateFromPath(), you need to call ILFree() when you are done using the returned PItemIDList.
Also, you should not be dereferencing the PItemIDList. SHCreateShellItemArrayFromIDLists() expects an array of PItemIDList pointers, but you are giving it an array of ItemIDList instances.
Try this instead:
procedure TForm2.DeleteFiles;
var
iFileOp: IFileOperation;
iIDList : PItemIDList;
iItemArray : IShellItemArray;
Count : DWord;
begin
iFileOp := CreateComObject(CLSID_FileOperation) as IFileOperation;
iIDList := ILCreateFromPath(sPath);
try
OleCheck(SHCreateShellItemArrayFromIDLists(1, #iIDList, iItemArray));
finally
ILFree(iIDList);
end;
// Next test the number of items in iItemArray, which I'm expecting to be 1000
// seeing as the CreateFiles routine creates that many
OleCheck(iItemArray.GetCount(Count));
Caption := IntToStr(Count); // Duh, this shows Count to be 1, not the expected 1000
OleCheck(iFileOp.DeleteItems(iItemArray));
OleCheck( iFileOp.PerformOperations );
// Returns Exception 'No object for moniker'
end;
That being said, even if this were working correctly, you are not creating an IShellItemArray containing 1000 IShellItems for the individual files. You are creating an IShellItemArray containing 1 IShellItem for the C:\Temp subdirectory itself.
Which is fine if your goal is to delete the whole folder. But in that case, I would suggest using SHCreateItemFromIDList() or SHCreateItemFromParsingName() instead, and then pass that IShellItem to IFileOperation.DeleteItem().
But, if your goal is to delete the individual files without deleting the subdirectory as well, then you will have to either:
get the IShellFolder interface for the subdirectory, then enumerate the relative PIDLs of its files using IShellFolder.EnumObjects(), and then pass the PIDLs in an array to SHCreateShellItemArray().
get the IShellFolder interface of the subdirectory, then query it for an IDataObject interface using IShellFolder.GetUIObjectOf(), and then use SHCreateShellItemArrayFromDataObject(), or just give the IDataObject directly to IFileOperation.DeleteItems().
get an IShellItem interface for the subdirectory, then query its IEnumShellItems interface using IShellItem.BindToHandler(), and then pass that directly to IFileOperation.DeleteItems().

Delphi7, Save User's Changes or other User's Information / Notes

In my program, the user completes a form and then presses Submit. Then, a textfile or a random extension file is created, in which all the user's information is written. So, whenever the user runs the application form, it will check if the file, which has all the information, exists, then it copies the information and pastes it to the form. However, it is not working for some reason (no syntax errors):
procedure TForm1.FormCreate(Sender: TObject);
var
filedest: string;
f: TextFile;
info: array[1..12] of string;
begin
filedest := ExtractFilePath(ParamStr(0)) + 'User\Identity\IdentityofMyself.txt';
if FileExists(filedest) then
begin
AssignFile(f,filedest);
Reset(f);
ReadLn(info[1], info[2], info[3], info[4], info[5], info[6], info[7],
info[8], info[9], info[10], info[11], info[12]);
Edit1.Text := info[1];
Edit2.Text := info[2];
ComboBox1.Text := info[3];
ComboBox5.Text := info[4];
ComboBox8.Text := info[4];
ComboBox6.Text := info[5];
ComboBox7.Text := info[6];
Edit3.Text := info[7];
Edit4.Text := info[8];
Edit5.Text := info[11];
Edit6.Text := info[12];
ComboBox9.Text := info[9];
ComboBox10.Text := info[10];
CloseFile(f);
end
else
begin
ShowMessage('File not found');
end;
end;
The file exists, but it shows the message File not found. I don't understand.
I took the liberty of formatting the code for you. Do you see the difference (before, after)? Also, if I were you, I would name the controls better. Instead of Edit1, Edit2, Edit3 etc. you could use eFirstName, eLastName, eEmailAddr, etc. Otherwise it will become a PITA to maintain the code, and you will be likely to confuse e.g. ComboBox7 with ComboBox4.
One concrete problem with your code is this line:
readln(info[1], info[2], info[3], info[4], info[5], info[6], info[7],
info[8], info[9], info[10], info[11], info[12]);
You forgot to specify the file f!
Also, before I formatted your code, the final end of the procedure was missing. Maybe your blocks are incorrect in your actual code, so that ShowMessage will be displayed even if the file exists? (Yet another reason to format your code properly...)
If I encountered this problem and wanted to do some quick debugging, I'd insert
ShowMessage(BoolToStr(FileExists(filedest), true));
Exit;
just after the line
filedest := ...
just to see what the returned value of FileExists(filedest) is. (Of course, you could also set a breakpoint and use the debugger.)
If you get false, you probably wonder what in the world filedest actually contains: Well, replace the 'debugging code' above with this one:
ShowMessage(filedest);
Exit;
Then use Windows Explorer (or better yet: the command prompt) to see if the file really is there or not.
I'd like to mention an another possibility to output a debug message (assuming we do not know how to operate real debugger yet):
{ ... }
filedest := ExtractFilePath(ParamStr(0)) + 'User\Identity\IdentityofMyself.txt';
AllocConsole; // create console window (uses Windows module) - required(!)
WriteLn('"' + filedest + '"'); // and output the value to verify
if FileExists(filedest) then
{ ... }

OLE Automation: How do i copy text between Word documents without using the clipboard

While doing som Word automation from Delphi XE, I have two documents open simultaneously. I want to copy the contents of a given range of one document to another range in the other document. How can I do this?
Consider the following code:
procedure TForm1.ManipulateDocuments;
var
vDoc1,vDoc2 : TWordDocument;
vFilename : olevariant;
vRange1,vRange2 : Range;
begin
vDoc1 := TWordDocument.Create(nil);
vDoc2 := TWordDocument.Create(nil);
try
vFilename := 'c:\temp\test1.doc';
vDoc1.ConnectTo(FWordApp.Documents.Open(vFilename,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam));
vFilename := 'c:\temp\test2.doc';
vDoc2.ConnectTo(FWordApp.Documents.Open(vFilename,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam));
vRange1 := GetSourceRange(vDoc1);
vRange2 := GetDestinationRange(vDoc2);
vRange2.CONTENTS := vRange1.CONTENTS; //What should I substitute for CONTENTS?
finally
vDoc1.Free;
vDoc2.Free;
end;
end;
Is there something I could substitute for CONTENTS? I can't use text, since I want to copy formatting, bookmarks, field codes etc. Do I have to do it another way alltogether? Any suggestions?
I don't know a way for earlier versions of Word, but for newer versions (2007 and up) you can export a range from a document to a fragment file, and then import it from another document. If you want early binding, you might need to import the type library (msword.olb), I don't know if Delphi XE has it. Otherwise the code might look like this:
function GetTempFileName(Prefix: string): string;
begin
SetLength(Result, MAX_PATH);
GetTempPath(MAX_PATH, PChar(Result));
windows.GetTempFileName(PChar(Result), PChar(Prefix), 0, PChar(Result));
end;
procedure TForm2.Button1Click(Sender: TObject);
const
// wdFormatDocument = 0;
wdFormatRTF = $00000006;
var
WordApp : OleVariant;
fragment: string;
vDoc1, vDoc2: OleVariant;
vRange1, vRange2: OleVariant;
begin
try
WordApp := GetActiveOleObject('Word.Application');
except
WordApp := CreateOleObject('Word.Application');
end;
WordApp.Visible := True;
vDoc1 := WordApp.Documents.Open(ExtractFilePath(Application.ExeName) + 'test1.doc');
vRange1 := vDoc1.Range(20, 120); // the export range
fragment := GetTempFileName('frg');
vRange1.ExportFragment(fragment, wdFormatRTF);
try
vDoc2 := WordApp.Documents.Open(ExtractFilePath(Application.ExeName) + 'test2.doc');
vRange2 := vDoc2.Range(15, 15); // where to import
vRange2.ImportFragment(fragment);
finally
DeleteFile(fragment);
end;
end;
With my test, 'document' format threw an error (something like not being able to insert XML formatting), hence usage of RTF format.
edit:
With earlier versions, it seems to be possible to insert a named selection from one document to a selection in another document. The result seems not to be perfect regarding formatting if one of the selections happens to be in the middle of some text. But otherwise it seems to be working good.
...
WordApp.Visible := True;
vDoc1 := WordApp.Documents.Open(ExtractFilePath(Application.ExeName) + 'test1.doc');
vRange1 := vDoc1.Range(20, 188); // the transfer range
vDoc1.Bookmarks.Add('TransferSection', vRange1); // arbitrary bookmark name
vDoc2 := WordApp.Documents.Open(ExtractFilePath(Application.ExeName) + 'test2.doc');
vRange2 := vDoc2.Range(103, 104); // where to import the bookmark
vRange2.Select;
vDoc2.ActiveWindow.Selection.InsertFile(vDoc1.FullName, 'TransferSection');
vDoc1.Bookmarks.Item('TransferSection').Delete; // no need for the bookmark anymore
 
If you can use the Office Open XML-format (ie. the docx file format that was introduced in Word 2007), then you can do this without automation.
Word versions prior to 2007 must install a compatibility pack which will enable docx-files for Word 2003, 2002 and 2000.
The docx-file is actually a zip-file that contains several xml-files. Try to change the extension of a docx-file from .docx to .zip and open this file in eg. WinZip.
So... Unzip docx-file and grab the xml-part you need. As pure string or as a xml document. Then you can inject this xml-part into the other docx-file. You need to know where in the xml-structure to grab/insert the xml, though. This will depend on how well you know the document structure and how much editing the user is allowed to do in the document.
I don't know how Word will handle duplicate bookmark names etc with this approach.
It seems I found the canonical solution to this question while digged into similar problem. The FormattedText property of Range object is the exact what do you need. Just use:
vRange2.FormattedText := vRange1;
and the contents of vRange1 will be copied into vRange2. Also, this works too:
vRange2 := vRange1;
Though, the second statement doesn't copy the formatting.
Why not use the clipboard? If all the text is selected in vDoc1, then to copy this to the clipboard involves one simple call: vDoc1.copy. Similarly, copying the contents of the clipboard to the second document requires one simple call: vDoc2.paste. The clipboard buffer will hold all the formatting information.

Delphi - Read File To StringList, then delete and write back to file

I'm currently working on a program to generate the hashes of files, in Delphi 2010. As part of this I have a option to create User Presets, e.g. pre-defined choice of hashing algo's which the user can create/save/delete. I have the create and load code working fine. It uses a ComboBox and loads from a file "fhpre.ini", inside this file is the users presets stored in format of:-
PresetName
PresetCode (a 12 digit string using 0 for don't hash and 1 for do)
On application loading it loads the data from this file into the ComboBox and an Array with the ItemIndex of ComboBox matching the corrisponding correct string of 0's and 1's in the Array.
Now I need to implement a feature to have the user delete a preset from the list. So far my code is as follows,
procedure TForm1.Panel23Click(Sender : TObject);
var
fil : textfile;
contents : TStringList;
x,i : integer;
filline : ansistring;
filestream : TFileStream;
begin //Start Procedure
//Load data into StringList
contents := TStringList.Create;
fileStream := TFileStream.Create((GetAppData+'\RFA\fhpre.ini'), fmShareDenyNone);
Contents.LoadFromStream(fileStream);
fileStream.Destroy();
//Search for relevant Preset
i := 0;
if ComboBox4.Text <> Contents[i] then
begin
Repeat
i := i + 1;
Until ComboBox4.Text = Contents[i];
end;
contents.Delete(i); //Delete Relevant Preset Name
contents.Delete(i); //Delete Preset Digit String
//Write StringList back to file.
AssignFile(fil,(GetAppData+'\RFA\fhpre.ini'));
ReWrite(fil);
for i := 0 to Contents.Count -1 do
WriteLn(Contents[i]);
CloseFile(fil);
Contents.Free;
end;
However if this is run, I get a 105 error when it gets to the WriteLn section. I'm aware that the code isn't great, for example doesn't have checks for presets with same name, but that will come, I want to get the base code working first then can tweak and add extra checks etc.
Any help would be appreciated.
You are aware, I hope, that TStringList has LoadFromFile and SaveToFile methods?
And if you can't use those methods for some reason, why use a stream for reading but WriteLn for writing?
To write to a file using WriteLn, you must specify the file as the first argument:
WriteLn(fil, Contents[i]);
without the argument it tries to write to the console (which is presumably not available in your Windows application). Error 105 is "File not open for output".
Since you are dealing with an .ini file, you should be using the TIniFile class to manipulate its contents as needed. That will make your configuration and code much easier to maintain.
Here is what the final code looks like after implementing TStringlist.LoadFromFile and TStringList.SaveToFile. It could probably still benifit from some optimization but that will come in time.
Procedure TForm1.Panel23Click(Sender : TObject);
var
contents : TStringList;
i : integer;
begin //Start Procedure
//Load data into StringList
Contents := TStringList.Create;
Contents.LoadFromFile((GetAppData+'\RFA\fhpre.ini'));
//Search for relevant Preset
i := 0;
if ComboBox4.Text <> Contents[i] then
begin
Repeat
i := i + 1;
Until ComboBox4.Text = Contents[i];
end;
contents.Delete(i); //Delete Relevant Preset Name
contents.Delete(i); //Delete Preset Digit String
Contents.SaveToFile((GetAppData+'\RFA\fhpre.ini'));
AddPresetCombo(GetAppData+'\RFA\fhpre.ini'); //Populate Comobo With Presets From File
Form1.ComboBox4.ItemIndex := 0;
Contents.Free;
end;

FastReport preview not showing all pages

I'm using FastReport 4.7.31 in Turbo Delphi Pro.
The following procedure processes the data stored in several dated files depending on user input.
procedure TfrmMain.MyReportPrint;
var MDate : Tdate;
S, myfile : string;
firstone: boolean;
// Date1, Date2 & ShowPreview are global variables set via a dialog box
begin
firstone := true;
MDate := Date1;
while MDate < IncDay(Date2, 1) do
begin
DateTimeToString(S,'yyyymmdd',MDate);
myfile := 'm' + S + '.dbf';
if FileExists(DataPath + '\' + myfile) then
begin
tblPS.Close;
tblPS.TableName := myfile;
frxMyReport.PrepareReport(firstone);
firstone := false;
end;
MDate := IncDay(MDate, 1);
end;
if ShowPreview then frxMyReport.ShowReport else frxMyReport.Print;
end;
frxMyReport.Print prints all the pages.
frxMyReport.ShowReport shows only the last page prepared.
The ShowReport method takes an optional parameter ClearLastReport, and its default value is true. Whether it's true or false, ShowReport prepares the report before displaying it, so in your code, you're discarding everything you've already prepared and then re-preparing the report using the most recently assigned table settings. If the only change you were to make to your code would be to pass False to ShowReport, then you'd find that the preview showed all your pages, but repeated the last page.
In contrast to ShowReport, the Print method does not prepare the report. It only prints what has already been prepared. You want ShowPreparedReport for your preview, not ShowReport. See section 1.9 of the FastReport Programmer's Manual.

Resources