Databases
StackOverflow2013
Postsdbo
POWriting to Excel cell with OpenXml while preserving cell's existing background
 

Note that there are some explanatory texts on larger screens.

plurals
  1. POWriting to Excel cell with OpenXml while preserving cell's existing background
    primarykey
    data
    text
    <p>We use documentFormat.OpenXML in this .Net class to read and write to Excel cells in an existing Excel worksheet. When using the WriteCell method, you may pass an optional backcolor attribute. If no backcolor the background is provided to the WriteCell method, then if there is an existing background color in a cell on which WriteCell is called, then that existing color should be preserved. I.e., if through Excel the bakground color of A1 is set to blue in the original Excel file, the background blue should be preserved when WriteCell is called without passing a backcolor attribute to it? With this class, however, all existing fills set through Excel are turned into black, when WriteCell is called on them without passing a new backcolor.</p> <pre><code> Imports DocumentFormat.OpenXml Imports DocumentFormat.OpenXml.Spreadsheet Imports DocumentFormat.OpenXml.Packaging Imports System.IO Public Class ExcelByOpenXML Dim sDocName As String Dim sDocNameTemp As String Dim sSheetName As String Dim sDocNameToReopen As String = "" Dim oDocument As SpreadsheetDocument Dim oDocumentOrg As SpreadsheetDocument Dim oSheet As Sheet Dim oWorkbookPart As WorkbookPart Dim oWorksheetPart As WorksheetPart Dim oStylesheet As Stylesheet Dim iLastCreatedFont As Integer Dim sLastCreatedFont As String Dim iLastCreatedFill As Integer Dim sLastCreatedFill As String Dim iLastCreatedStyle As Integer Dim sLastCreatedStyle As String Public Function OpenDoc(ByVal Doc As String) As Boolean Try sDocName = Doc sDocNameTemp = Path.GetTempPath + Doc.Substring(Doc.LastIndexOf("\") + 1) FileCopy(IIf(sDocNameToReopen.Length &gt; 0, sDocNameToReopen, sDocName), sDocNameTemp) oDocumentOrg = SpreadsheetDocument.Open(sDocName, True) oDocument = SpreadsheetDocument.Open(sDocNameTemp, True) Return True Catch Return False End Try End Function Public Function opensheet(ByVal Sheet As String) As Boolean Dim oSheets As Sheets Dim oTmpSheet As Sheet Try sSheetName = Sheet oWorkbookPart = oDocument.WorkbookPart oSheets = oWorkbookPart.Workbook.Sheets For Each oTmpSheet In oSheets If oTmpSheet.Name = Sheet Then oSheet = oTmpSheet Exit For End If Next If IsNothing(oSheet) Then Return False End If oWorksheetPart = CType(oWorkbookPart.GetPartById(oSheet.Id), WorksheetPart) oStylesheet = oWorkbookPart.WorkbookStylesPart.Stylesheet iLastCreatedFont = 0 sLastCreatedFont = "" iLastCreatedFill = 0 sLastCreatedFill = "" iLastCreatedStyle = 0 sLastCreatedStyle = "" Return True Catch ex As Exception Return False End Try End Function Public Function SaveDocAs(ByVal Name As String, ByVal Path As String) As Boolean If IsNothing(oDocument) Then Return False End If oDocument.Close() oDocumentOrg.Close() FileCopy(sDocNameTemp, Path + Name) sDocNameToReopen = "" Return True End Function Public Function SaveDoc() As Boolean If IsNothing(oDocument) Then Return False End If oDocument.Close() oDocumentOrg.Close() FileCopy(sDocNameTemp, sDocName) Return True End Function Public Function WriteCell(ByVal Col As String, ByVal Row As Integer, ByVal Val As String, Optional ByVal halign As Integer = 1, Optional ByVal Valign As Integer = 0, Optional ByVal fnt As String = "Calibri", Optional ByVal fntSize As Integer = 10, Optional ByVal foreColor As String = "00000000", Optional ByVal backColor As String = "", Optional ByVal isFormula As Boolean = False) As Boolean If IsNothing(oDocument) Then Return False End If Dim oCell As Cell Dim myCellFormat As CellFormat Dim myCellFormat1 As CellFormat Dim ct1 As ColorType Try oCell = CreateSpreadsheetCell(Col, Row) Dim cellStyleIndex As Integer Dim sReturnString1(5) As String If IsNothing(oCell.StyleIndex) Then cellStyleIndex = 0 Else cellStyleIndex = oCell.StyleIndex.Value End If myCellFormat1 = oWorkbookPart.WorkbookStylesPart.Stylesheet.CellFormats.ChildElements(cellStyleIndex) Dim myFill1 As Fill = oWorkbookPart.WorkbookStylesPart.Stylesheet.Fills.ChildElements(myCellFormat1.FillId.Value) Dim myPatternFill1 As PatternFill = myFill1.PatternFill ct1 = myPatternFill1.BackgroundColor 'This section is new, still does not work. If Not IsNothing(ct1.Indexed) Then myCellFormat = New CellFormat() myCellFormat.FillId = CreateFill(System.Drawing.ColorTranslator.FromOle(ct1.Indexed.Value).ToString()) End If If isFormula Then If Not IsNothing(oCell.CellFormula) Then oCell.CellFormula.Text = Val Else Dim oCellFormula As CellFormula = New CellFormula(Val) oCell.Append(oCellFormula) End If Else Dim myCellValue As CellValue oCell.DataType = CellValues.String If Not IsNothing(oCell.CellValue) Then myCellValue = oCell.CellValue Else myCellValue = New CellValue() oCell.Append(myCellValue) End If myCellValue.Text = Val End If Dim bcolor As String = "" Dim fontname As String = "" Dim fontsize As Integer = 0 Dim sTest3() As String sTest3 = ReadCell(Col, Row) If (sTest3(1).Length &gt; 0) Then fontname = sTest3(1).ToString() If (sTest3(2).Length &gt; 0) Then fontsize = Convert.ToInt32(sTest3(2)) If (sTest3(4).Length &gt; 0) Then bcolor = sTest3(4).ToString() Dim chk_flag As Integer = 0 If sLastCreatedStyle &lt;&gt; fnt + ";;" + fntSize.ToString() + ";;" + foreColor + ";;" + backColor Then myCellFormat = New CellFormat() myCellFormat.FormatId = Convert.ToUInt32(0) If (backColor.Length &gt; 0) Then myCellFormat.FillId = CreateFill(backColor) ElseIf (bcolor.Length &gt; 0) Then myCellFormat.FillId = CreateFill(bcolor) Else myCellFormat.FillId = CreateFill(System.Drawing.ColorTranslator.FromOle(ct1.Indexed.Value).ToString()) chk_flag = 1 End If myCellFormat.BorderId = Convert.ToUInt32(0) If (fnt &lt;&gt; "Calibri") Then fnt = fnt.ToString() ElseIf (fontname.Length &gt; 0) Then fnt = fontname.ToString() End If If (fntSize &lt;&gt; 10) Then fntSize = fntSize ElseIf (fontsize &gt; 0) Then fntSize = fontsize End If myCellFormat.FontId = CreateFont(fnt, fntSize, foreColor) myCellFormat.NumberFormatId = Convert.ToUInt32(0) Dim value As New Alignment value.Horizontal = halign 'HorizontalAlignmentValues.Left=1 myCellFormat.Alignment = value value.Vertical = Valign 'VerticalAlignmentValues.top=0 myCellFormat.Alignment = value myCellFormat.ApplyFill = True myCellFormat.ApplyFont = True oStylesheet.CellFormats.Append(myCellFormat) iLastCreatedStyle = oStylesheet.CellFormats.Count.Value oStylesheet.CellFormats.Count.Value += 1 sLastCreatedStyle = fnt + ";;" + fntSize.ToString() + ";;" + foreColor + ";;" + backColor End If If (chk_flag = 0) Then oCell.StyleIndex = Convert.ToUInt32(iLastCreatedStyle) Return True Catch Return False End Try End Function Public Function ReadCell(ByVal Col As String, ByVal Row As Integer) As String() Dim oCell As Cell Dim sReturnString(6) As String If IsNothing(oDocument) Then 'return empty - the file is not open Return sReturnString End If Try oCell = CreateSpreadsheetCell(Col, Row) sReturnString(0) = ReadCellValue(oCell) Dim iCellStyleIndex As Integer If IsNothing(oCell.StyleIndex) Then iCellStyleIndex = 0 Else iCellStyleIndex = oCell.StyleIndex.Value End If Dim oCellFormat As CellFormat = oWorkbookPart.WorkbookStylesPart.Stylesheet.CellFormats.ChildElements(iCellStyleIndex) Dim iFontId As Integer If IsNothing(oCellFormat.FontId) Then iFontId = 0 Else iFontId = oCellFormat.FontId.Value End If Dim myFont As Font = oWorkbookPart.WorkbookStylesPart.Stylesheet.Fonts.ChildElements(iFontId) sReturnString(1) = myFont.FontName.Val sReturnString(2) = myFont.FontSize.Val Try sReturnString(3) = myFont.Color.Rgb.ToString() Catch sReturnString(3) = "" End Try 'read fore and back color Dim myFill As Fill = oWorkbookPart.WorkbookStylesPart.Stylesheet.Fills.ChildElements(oCellFormat.FillId.Value) Dim myPatternFill As PatternFill = myFill.PatternFill If Not IsNothing(myPatternFill.ForegroundColor) Then sReturnString(4) = PrintColorType(myPatternFill.ForegroundColor) 'If Not IsNothing(myPatternFill.BackgroundColor) Then sReturnString(6) = PrintColorType(myPatternFill.BackgroundColor) 'cell is a formula or not If Not IsNothing(oCell.CellFormula) Then sReturnString(5) = "True" Else sReturnString(5) = "False" End If Return sReturnString Catch Return sReturnString End Try End Function Public Function SimpleReadCell(ByVal Col As String, ByVal Row As Integer) As String Dim oCell As Cell Dim addressName As String = Col + Row.ToString Dim sValue As String = "" If IsNothing(oDocument) Then Return "" End If Try oCell = CreateSpreadsheetCell(Col, Row) sValue = ReadCellValue(oCell) Return sValue Catch Return "" End Try End Function Public Function CloseDoc() As Boolean Try 'clear variables ClearVariables() Return True Catch Return False End Try End Function Public Function RowHeight(ByVal iRow As Integer, ByVal iHeight As Integer) As Boolean Dim myRow As Row Dim myRowCopy As Row = Nothing Dim isChanged As Boolean = False Try If IsNothing(oDocument) Then Return False Dim rows As IEnumerable(Of Row) = oWorksheetPart.Worksheet.Descendants(Of Row)().Where(Function(r) r.RowIndex.Value = iRow.ToString()) If (rows.Count = 0) Then myRow = InsertRow(iRow) Else myRow = rows.First End If myRow.Height = iHeight myRow.CustomHeight = True Return True Catch Return False End Try End Function Public Function ColumnWidth(ByVal Col As String, ByVal Width As Integer) As Boolean Dim myColsObj As Columns Dim myColumn As Column Dim iCol As Integer If IsNothing(oDocument) Then Return False Try iCol = TranslateColumnNameToIndex(Col) Dim myCols As IEnumerable(Of Column) = oWorksheetPart.Worksheet.Descendants(Of Column)() If myCols.Count = 0 Then myColsObj = New Columns Dim myCol As Column = New Column myCol.Min = Convert.ToUInt32(1) myCol.Max = Convert.ToUInt32(25) myCol.CustomWidth = False myCol.Width = 15 myColsObj.Append(myCol) Dim mySheetData As SheetData = oWorksheetPart.Worksheet.GetFirstChild(Of SheetData)() oWorksheetPart.Worksheet.InsertBefore(myColsObj, mySheetData) Else myColsObj = oWorksheetPart.Worksheet.GetFirstChild(Of Columns)() End If For Each myColumn In oWorksheetPart.Worksheet.Descendants(Of Column)() If (myColumn.Min.Value = iCol And myColumn.Max.Value = iCol) Then myColumn.Width = Width myColumn.CustomWidth = True Exit For ElseIf (myColumn.Min.Value &lt;= iCol And myColumn.Max.Value &gt;= iCol) Then If myColumn.Min.Value = iCol Then Dim cNewColumn As Column cNewColumn = myColumn.Clone cNewColumn.Min.Value = cNewColumn.Min.Value + 1 oWorksheetPart.Worksheet.AppendChild(cNewColumn) myColumn.Width = Width myColumn.CustomWidth = True myColumn.Max.Value = iCol End If If myColumn.Max.Value = iCol Then Dim cNewColumn As Column cNewColumn = myColumn.Clone cNewColumn.Max.Value = cNewColumn.Max.Value - 1 oWorksheetPart.Worksheet.AppendChild(cNewColumn) myColumn.Width = Width myColumn.CustomWidth = True myColumn.Min.Value = iCol End If If myColumn.Min.Value &lt; iCol And myColumn.Max.Value &gt; iCol Then Dim cNewColumn1 As Column cNewColumn1 = myColumn.Clone cNewColumn1.Max.Value = iCol - 1 myColsObj.InsertBefore(cNewColumn1, myColumn) Dim cNewColumn2 As Column cNewColumn2 = myColumn.Clone cNewColumn2.Min.Value = iCol + 1 myColsObj.InsertAfter(cNewColumn2, myColumn) myColumn.Width = Width myColumn.CustomWidth = True myColumn.Min.Value = iCol myColumn.Max.Value = iCol End If Exit For End If Next Return True Catch Return False End Try End Function #Region "Private methods" Private Sub ClearVariables() oSheet = Nothing oWorkbookPart = Nothing oWorksheetPart = Nothing oStylesheet = Nothing If Not IsNothing(oDocument) Then oDocument.Dispose() oDocument = Nothing End If If Not IsNothing(oDocumentOrg) Then oDocumentOrg.Dispose() oDocumentOrg = Nothing End If Try If Not IsNothing(sDocNameTemp) Then File.Delete(sDocNameTemp) End If Catch End Try End Sub 'convert a column name to index - sometimes is required Private Function TranslateColumnNameToIndex(ByVal name As String) As Integer Dim iPosition As Integer = 0 Dim chars() As Char chars = name.ToUpperInvariant().ToCharArray().Reverse().ToArray() Dim index As Integer Dim c As Integer For index = 0 To chars.Length - 1 c = Asc(chars(index)) - 64 iPosition += IIf(index = 0, c, (c * System.Math.Pow(26, index))) Next Return iPosition End Function Private Function CreateSpreadsheetCell(ByVal sCol As String, ByVal iRow As Integer) As Cell Dim cellReference As String = (sCol + iRow.ToString()) Dim rows As IEnumerable(Of Row) = oWorksheetPart.Worksheet.Descendants(Of Row)().Where(Function(r) r.RowIndex.Value = iRow.ToString()) Dim row As Row If (rows.Count = 0) Then row = InsertRow(iRow) Dim cell As Cell = New Cell() cell.CellReference = New StringValue(cellReference) row.Append(cell) Return cell Else row = rows.First End If If (row.Elements(Of Cell).Where(Function(c) c.CellReference.Value = cellReference).Count() &gt; 0) Then Return row.Elements(Of Cell).Where(Function(c) c.CellReference.Value = cellReference).First() Else Dim refCell As Cell = Nothing For Each cell As Cell In row.Elements(Of Cell)() If (String.Compare(cell.CellReference.Value, cellReference, True) &gt; 0) Then refCell = cell Exit For End If Next Dim newCell As Cell = New Cell newCell.CellReference = cellReference row.InsertBefore(newCell, refCell) Return newCell End If End Function 'function return the color RGB from colortype object Private Function PrintColorType(ByVal ct As ColorType) As String Try If Not IsNothing(ct.Auto) Then Return ("System auto color") If Not IsNothing(ct.Rgb) Then Return ct.Rgb.Value.ToString() If Not IsNothing(ct.Theme) Then Return ct.Theme.Value.ToString() If Not IsNothing(ct.Tint) Then Return ct.Tint.Value.ToString() If Not IsNothing(ct.Indexed) Then Dim a As Spreadsheet.RgbColor = oWorkbookPart.WorkbookStylesPart.Stylesheet.Colors.IndexedColors.ChildElements(ct.Indexed.Value) Return a.Rgb.ToString() End If Catch End Try Return "" End Function Private Function ReadCellValue(ByVal oCell As Cell) As String Dim sValue As String = "" If oCell IsNot Nothing Then sValue = oCell.InnerText If oCell.DataType IsNot Nothing Then Select Case oCell.DataType.Value Case CellValues.SharedString ' For shared strings, look up the value in the shared ' strings table. Dim stringTable = oWorkbookPart.GetPartsOfType(Of SharedStringTablePart).FirstOrDefault() ' If the shared string table is missing, something is wrong. ' Return the index that you found in the cell. ' Otherwise, look up the correct text in the table. If stringTable IsNot Nothing Then sValue = stringTable.SharedStringTable.ElementAt(Integer.Parse(sValue)).InnerText End If Case CellValues.Boolean Select Case sValue Case "0" sValue = "FALSE" Case Else sValue = "TRUE" End Select End Select End If If Not IsNothing(oCell.CellFormula) Then 'sValue = oCell.CellFormula.Text sValue = oCell.CellValue.Text End If End If Return sValue End Function Private Function CreateFont(ByVal sFontName As String, ByVal iFontSize As Integer, ByVal sForeColor As String) As UInt32Value If sFontName + ";;" + iFontSize.ToString() + ";;" + sForeColor &lt;&gt; sLastCreatedFont Then Dim myFont As Font = New Font() 'set font size Dim myFontSize As FontSize = New FontSize() myFontSize.Val = iFontSize myFont.Append(myFontSize) Dim myColor As Spreadsheet.Color = New Spreadsheet.Color myColor.Rgb = sForeColor myFont.Append(myColor) Dim myFontName As FontName = New FontName() myFontName.Val = sFontName myFont.Append(myFontName) oStylesheet.Fonts.Append(myFont) iLastCreatedFont = oStylesheet.Fonts.Count.Value oStylesheet.Fonts.Count.Value += 1 sLastCreatedFont = sFontName + ";;" + iFontSize.ToString() + ";;" + sForeColor End If Return iLastCreatedFont End Function Private Function CreateFill(ByVal fillColor As String) As UInt32Value If sLastCreatedFill &lt;&gt; fillColor Then Dim myFill As Fill = New Fill() Dim myPatterFill As PatternFill = New PatternFill() Dim myFore As ForegroundColor = New ForegroundColor() myFore.Rgb = fillColor myPatterFill.Append(myFore) 'back color 'Dim myBack As BackgroundColor = New BackgroundColor() 'myBack.Rgb = fillColor 'myBack.Indexed = New UInt32Value(Convert.ToUInt32(64)) 'myPatterFill.Append(myBack) myPatterFill.PatternType = PatternValues.Solid myFill.Append(myPatterFill) oStylesheet.Fills.Append(myFill) iLastCreatedFill = oStylesheet.Fills.Count.Value oStylesheet.Fills.Count.Value += 1 sLastCreatedFill = fillColor End If Return iLastCreatedFill End Function Private Function InsertSharedStringItem(ByVal text As String) As Integer If (oWorkbookPart.SharedStringTablePart.SharedStringTable Is Nothing) Then oWorkbookPart.SharedStringTablePart.SharedStringTable = New SharedStringTable End If Dim i As Integer = 0 For Each item As SharedStringItem In oWorkbookPart.SharedStringTablePart.SharedStringTable.Elements(Of SharedStringItem)() If (item.InnerText = text) Then Return i End If i = (i + 1) Next oWorkbookPart.SharedStringTablePart.SharedStringTable.AppendChild(New SharedStringItem(New DocumentFormat.OpenXml.Spreadsheet.Text(text))) oWorkbookPart.SharedStringTablePart.SharedStringTable.Save() Return i End Function Private Function InsertRow(ByVal iRowIndex As Integer) As Row Dim myRow = New Row() myRow.RowIndex = New UInt32Value(Convert.ToUInt32(iRowIndex)) Dim mySheetData As SheetData mySheetData = oWorksheetPart.Worksheet.GetFirstChild(Of SheetData)() Dim tmpRows As IEnumerable(Of Row) = oWorksheetPart.Worksheet.Descendants(Of Row)() If tmpRows.Count = 0 Then mySheetData.Append(myRow) Return myRow End If Dim tRow As Row = Nothing For Each tRow In tmpRows If tRow.RowIndex.Value &gt; iRowIndex Then mySheetData.InsertBefore(myRow, tRow) Return myRow End If Next mySheetData.InsertAfter(myRow, tRow) Return myRow End Function #End Region End Class </code></pre>
    singulars
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. PTQuestion
    1. USuser743094
    1. USuser743094
    plurals
    1. This table or related slice is empty.
    1. PL
      singulars
      1. LTLinked
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. COWhat exactly are you trying to do? Open existing workbook and change some values? Create a workbook based on an existing workbook? What did you try?
      singulars
      1. POWriting to Excel cell with OpenXml while preserving cell's existing background
      1. USChris
    2. COOpen an existing woorkbook, change some values, then save the workbook or save the workbook as a new workbook. The class that does this has method that opens an existing workbook, a method that sets the active worksheet, a method that writes to cells (which method can be passed optional formatting parameters), a method that saves the workbook, and a method that saves the workbook in a new file.
      singulars
      1. POWriting to Excel cell with OpenXml while preserving cell's existing background
      1. USuser743094
    3. COWe will need more information about "The class that does this"
      singulars
      1. POWriting to Excel cell with OpenXml while preserving cell's existing background
      1. USChris
 

Querying!

 
Guidance
A row detail

Detail views are divided into sections. All the information in the data section comes from columns in the selected row. The other sections display data from other, related rows.

Related data can be related in a to-one or a to-many fashion. Captions of data related in a to-many fashion link to a list view showing a filtered view of the table.

Try moving around until you find a non-empty to-many entry and click on the label to get to one. You can move back to the root by clicking on the database name in the header.

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload