I am using the MS Dynamics Navision 2013 R2 Excel Buffer table to generate an Excel spreadsheet and would like to extend it to allow for the setting of font name, font size, font colour and fill colour.
I have managed to set these additional properties using the solution given by Saurav Dhyani in his NAV 2013 R2 - Export To Excel With Font & Color blog post but that solution doesn't retain the setting of the Bold, Italics and Underline properties when the font is changed. Comments on his post suggest that this is something that hasn't yet been resolved.
My implementation of Saurav's solution involves adding the fields "Font Name" (Text 100), "Font Size" (Integer), "Font Colour" (Integer) and "Background Colour" (Integer) to the Excel Buffer table (Table 370). These fields can be set by the calling module. All calls to the GetCellDecorator function in the Excel Buffer table are then replaced by calls to a new GetCellDecoratorWithFont function instead. This function takes the same parameters as the existing GetCellDecorator function plus a parameter for each of the new table fields.
The GetCellDecoratorWithFont function looks like this:
IF IsBold AND IsItalic AND IsUnderlined THEN
Decorator := XlWrkShtWriter.DefaultBoldItalicUnderlinedCellDecorator
ELSE IF IsBold AND IsItalic THEN
Decorator := XlWrkShtWriter.DefaultBoldItalicCellDecorator
ELSE IF IsBold AND IsUnderlined THEN
Decorator := XlWrkShtWriter.DefaultBoldUnderlinedCellDecorator
ELSE IF IsBold THEN
Decorator := XlWrkShtWriter.DefaultBoldCellDecorator
ELSE IF IsItalic AND IsUnderlined THEN
Decorator := XlWrkShtWriter.DefaultItalicUnderlinedCellDecorator
ELSE IF IsItalic THEN
Decorator := XlWrkShtWriter.DefaultItalicCellDecorator
ELSE IF IsUnderlined THEN
Decorator := XlWrkShtWriter.DefaultUnderlinedCellDecorator
ELSE
Decorator := XlWrkShtWriter.DefaultCellDecorator;
IF (FontName <> '') OR (FontSize <> 0) OR (FontColour <> 0) OR (BackgroundColour <> 0) THEN
CustomFont := Decorator.Font.CloneNode(TRUE)
ELSE
EXIT;
IF FontName <> '' THEN BEGIN
CustomFont := CustomFont.Font;
CustomFontName := CustomFontName.FontName;
CustomFontName.Val := XmlStringValue.StringValue(FontName);
CustomFont.FontName := CustomFontName;
END;
IF FontSize <> 0 THEN BEGIN
CustomFontSize := CustomFontSize.FontSize;
CustomFontSize.Val := FontSizeValue.DoubleValue(FontSize);
CustomFont.FontSize := CustomFontSize;
END;
IF FontColour <> 0 THEN BEGIN
CustomColour := CustomColour.Color;
CASE FontColour OF
1 : CustomColour.Rgb := HexColour.HexBinaryValue(ColourBlack);
2 : CustomColour.Rgb := HexColour.HexBinaryValue(ColourWhite);
3 : CustomColour.Rgb := HexColour.HexBinaryValue(ColourRed);
4 : CustomColour.Rgb := HexColour.HexBinaryValue(ColourBlue);
5 : CustomColour.Rgb := HexColour.HexBinaryValue(ColourGreen);
6 : CustomColour.Rgb := HexColour.HexBinaryValue(ColourRose);
7 : CustomColour.Rgb := HexColour.HexBinaryValue(ColourLightGrey);
ELSE
CustomColour.Rgb := HexColour.HexBinaryValue(ColourBlack);
END;
CustomFont.Color := CustomColour;
END;
IF BackgroundColour <> 0 THEN BEGIN
HexBackgroundColour := '';
CASE BackgroundColour OF
1 : HexBackgroundColour := ColourBlack;
2 : HexBackgroundColour := ColourWhite;
3 : HexBackgroundColour := ColourRed;
4 : HexBackgroundColour := ColourBlue;
5 : HexBackgroundColour := ColourGreen;
6 : HexBackgroundColour := ColourRose;
7 : HexBackgroundColour := ColourLightGrey;
ELSE
HexBackgroundColour := ColourWhite;
END;
CustomCellFill := Decorator.Fill.CloneNode(TRUE);
CustomCellPatternFill := CustomCellPatternFill.PatternFill(
'<x:patternFill xmlns:x="http://schemas.openxmlformats.org/spreadsheetml/2006/main" '+'patternType="'+'solid'+'">' +
'<x:fgColor rgb="' + HexBackgroundColour + '" /></x:patternFill>');
CustomCellFill.PatternFill := CustomCellPatternFill;
Decorator.Fill := CustomCellFill;
END;
Fonts := XlWrkBkWriter.Workbook.WorkbookPart.WorkbookStylesPart.Stylesheet.Fonts;
Decorator.Font := CustomFont;
ColourBlack, ColourWhite etc are text constants using the colour's hex value.
When calling this code the font and the fill colour are all set as expected, but the Bold, Italics and Underline aren't. Removing the last line of the function:
Decorator.Font := CustomFont;
restores the Bold, Italics and Underline but loses all the other formatting.
Is there a way of adding the additional properties while retaining the original ones?
To answer my own question...
Saurav Dhyani (see link in question) updated his blog to correct the problem with the Bold, Underline and Italics properties being overwritten by implementing the additional font properties. I have made some changes to his code (discussed on his blog). This is my implementation of the GetCellDecoratorWithFont function in the Excel Buffer table:-
Decorator := XlWrkShtWriter.DefaultCellDecorator;
IF (FontName <> '') OR (FontSize <> 0) OR (FontColour <> 0) OR (BackgroundColour <>0) THEN
CustomFont := Decorator.Font.CloneNode(TRUE)
ELSE BEGIN
IF IsBold AND IsItalic AND IsUnderlined THEN
Decorator := XlWrkShtWriter.DefaultBoldItalicUnderlinedCellDecorator
ELSE IF IsBold AND IsItalic THEN
Decorator := XlWrkShtWriter.DefaultBoldItalicCellDecorator
ELSE IF IsBold AND IsUnderlined THEN
Decorator := XlWrkShtWriter.DefaultBoldUnderlinedCellDecorator
ELSE IF IsBold THEN
Decorator := XlWrkShtWriter.DefaultBoldCellDecorator
ELSE IF IsItalic AND IsUnderlined THEN
Decorator := XlWrkShtWriter.DefaultItalicUnderlinedCellDecorator
ELSE IF IsItalic THEN
Decorator := XlWrkShtWriter.DefaultItalicCellDecorator
ELSE IF IsUnderlined THEN
Decorator := XlWrkShtWriter.DefaultUnderlinedCellDecorator
ELSE
Decorator := XlWrkShtWriter.DefaultCellDecorator;
EXIT;
END;
IF FontName <> '' THEN BEGIN
CustomFont := CustomFont.Font;
CustomFontName := CustomFontName.FontName;
CustomFontName.Val := XmlStringValue.StringValue(FontName);
CustomFont.FontName := CustomFontName;
END;
IF FontSize <> 0 THEN BEGIN
CustomFontSize := CustomFontSize.FontSize;
CustomFontSize.Val := FontSizeValue.DoubleValue(FontSize);
CustomFont.FontSize := CustomFontSize;
END;
IF FontColour <> 0 THEN BEGIN
CustomColour := CustomColour.Color;
CASE FontColour OF
1 : CustomColour.Rgb := HexColour.HexBinaryValue(ColourBlack);
2 : CustomColour.Rgb := HexColour.HexBinaryValue(ColourWhite);
3 : CustomColour.Rgb := HexColour.HexBinaryValue(ColourRed);
4 : CustomColour.Rgb := HexColour.HexBinaryValue(ColourBlue);
5 : CustomColour.Rgb := HexColour.HexBinaryValue(ColourGreen);
6 : CustomColour.Rgb := HexColour.HexBinaryValue(ColourRose);
7 : CustomColour.Rgb := HexColour.HexBinaryValue(ColourLightGrey);
ELSE
CustomColour.Rgb := HexColour.HexBinaryValue(ColourBlack);
END;
CustomFont.Color := CustomColour;
END;
IF BackgroundColour <> 0 THEN BEGIN
HexBackgroundColour := '';
CASE BackgroundColour OF
1 : HexBackgroundColour := ColourBlack;
2 : HexBackgroundColour := ColourWhite;
3 : HexBackgroundColour := ColourRed;
4 : HexBackgroundColour := ColourBlue;
5 : HexBackgroundColour := ColourGreen;
6 : HexBackgroundColour := ColourRose;
7 : HexBackgroundColour := ColourLightGrey;
ELSE
HexBackgroundColour := ColourWhite;
END;
CustomCellFill := Decorator.Fill.CloneNode(TRUE);
CustomCellPatternFill := CustomCellPatternFill.PatternFill(
'<x:patternFill xmlns:x="http://schemas.openxmlformats.org/spreadsheetml/2006/main" '+'patternType="'+'solid'+'">' +
'<x:fgColor rgb="' + HexBackgroundColour + '" /></x:patternFill>');
CustomCellFill.PatternFill := CustomCellPatternFill;
Decorator.Fill := CustomCellFill;
END;
IF IsBold THEN BEGIN
CustomFontBold := CustomFontBold.Bold;
CustomFontBold.Val := XmlBooleanValue.BooleanValue(TRUE);
CustomFont.Bold := CustomFontBold;
END;
IF IsItalic THEN BEGIN
CustomFontItalic := CustomFontItalic.Italic;
CustomFontItalic.Val := XmlBooleanValue.BooleanValue(TRUE);
CustomFont.Italic := CustomFontItalic;
END;
IF IsUnderlined THEN BEGIN
// CustomFontUnderline := CustomFontUnderline.Underline;
// CustomFontUnderline.Val := XmlBooleanValue.BooleanValue(TRUE);
// CustomFont.Underline := CustomFontUnderline;
END;
Fonts := XlWrkBkWriter.Workbook.WorkbookPart.WorkbookStylesPart.Stylesheet.Fonts;
Decorator.Font := CustomFont;
The implementation of the Underline property as shown isn't working so needs to be corrected.
The local variables for the function are:-
CustomFont:DocumentFormat.OpenXml.Spreadsheet.Font.'DocumentFormat.OpenXml, Version=2.5.5631.0, Culture=neutral, PublicKeyToken=31bf3856ad364e35'
CustomFontName:DocumentFormat.OpenXml.Spreadsheet.FontName.'DocumentFormat.OpenXml, Version=2.5.5631.0, Culture=neutral, PublicKeyToken=31bf3856ad364e35'
CustomFontSize:DocumentFormat.OpenXml.Spreadsheet.FontSize.'DocumentFormat.OpenXml, Version=2.5.5631.0, Culture=neutral, PublicKeyToken=31bf3856ad364e35'
CustomFontBold:DocumentFormat.OpenXml.Spreadsheet.Bold.'DocumentFormat.OpenXml, Version=2.0.5631.0, Culture=neutral, PublicKeyToken=31bf3856ad364e35'
CustomFontItalic:DocumentFormat.OpenXml.Spreadsheet.Italic.'DocumentFormat.OpenXml, Version=2.0.5631.0, Culture=neutral, PublicKeyToken=31bf3856ad364e35'
CustomFontUnderline:DocumentFormat.OpenXml.Spreadsheet.Underline.'DocumentFormat.OpenXml, Version=2.0.5631.0, Culture=neutral, PublicKeyToken=31bf3856ad364e35'
XmlStringValue:DocumentFormat.OpenXml.StringValue.'DocumentFormat.OpenXml, Version=2.5.5631.0, Culture=neutral, PublicKeyToken=31bf3856ad364e35'
XmlBooleanValue:DocumentFormat.OpenXml.BooleanValue.'DocumentFormat.OpenXml, Version=2.0.5631.0, Culture=neutral, PublicKeyToken=31bf3856ad364e35'
FontSizeValue:DocumentFormat.OpenXml.DoubleValue.'DocumentFormat.OpenXml, Version=2.5.5631.0, Culture=neutral, PublicKeyToken=31bf3856ad364e35'
CustomColour:DocumentFormat.OpenXml.Spreadsheet.Color.'DocumentFormat.OpenXml, Version=2.5.5631.0, Culture=neutral, PublicKeyToken=31bf3856ad364e35'
HexColour:DocumentFormat.OpenXml.HexBinaryValue.'DocumentFormat.OpenXml, Version=2.5.5631.0, Culture=neutral, PublicKeyToken=31bf3856ad364e35'
CustomCellFill:DocumentFormat.OpenXml.Spreadsheet.Fill.'DocumentFormat.OpenXml, Version=2.5.5631.0, Culture=neutral, PublicKeyToken=31bf3856ad364e35'
CustomCellPatternFill:DocumentFormat.OpenXml.Spreadsheet.PatternFill.'DocumentFormat.OpenXml, Version=2.5.5631.0, Culture=neutral, PublicKeyToken=31bf3856ad364e35'
Fonts:DocumentFormat.OpenXml.Spreadsheet.Fonts.'DocumentFormat.OpenXml, Version=2.5.5631.0, Culture=neutral, PublicKeyToken=31bf3856ad364e35'
HexBackgroundColour:Text(10)