I'm posting this to help others that may be going through the struggle I went through when trying to add simple notes or threaded comments to an excel spreadsheet using the DocumentFormat.OpenXML library using VB.Net.
I've added my own answer.
Imports System.Text
Imports DocumentFormat.OpenXml
Imports DocumentFormat.OpenXml.Packaging
Imports DocumentFormat.OpenXml.Spreadsheet
Imports System.Runtime.CompilerServices
Imports System.Xml
Imports System.IO
Imports System.Text.RegularExpressions
Imports DocumentFormat.OpenXml.Office2019.Excel.ThreadedComments
Public Class ExcelDocInfo
Public Property WBPart As WorkbookPart = Nothing
Public Property WSPart As WorksheetPart = Nothing
Public Property SData As SheetData = Nothing
End Class
Public Class CellReferenceIndexes
Public ColumnIndex As Integer? = Nothing
Public RowIndex As Integer? = Nothing
Public Sub New()
End Sub
End Class
Public Class OpenXML
Public Shared Function GetThreadedCommentVMLShapeXML(CellReference As String, CommentCount As Integer)
Dim commentVmlXml As String = String.Empty
commentVmlXml = <![CDATA[
<v:shape id="[ShapeID]" type="#_x0000_t202" style='position:absolute; margin-left:59.25pt;margin-top:1.5pt;width:108pt;height:59.25pt;z-index:1; visibility:hidden' fillcolor="infoBackground [80]" strokecolor="none [81]" o:insetmode="auto">
<v:fill color2="infoBackground [80]"/>
<v:shadow color="none [81]" obscured="t"/>
<v:path o:connecttype="none"/>
<v:textbox style='mso-direction-alt:auto'>
<div style='text-align:left'></div>
</v:textbox>
<x:ClientData ObjectType="Note">
<x:MoveWithCells/>
<x:SizeWithCells/>
<x:Anchor>[CoordinatesForVMLCommentShape]</x:Anchor>
<x:AutoFill>False</x:AutoFill>
<x:Row>[RowIndex]</x:Row>
<x:Column>[ColumnIndex]</x:Column>
</x:ClientData>
</v:shape>
]]>.Value.Trim()
Dim ShapeId As String = "_x0000_s" & (1109 + CommentCount + 1).ToString()
commentVmlXml = commentVmlXml.Replace("[ShapeID]", ShapeId)
commentVmlXml = commentVmlXml.Replace("[CoordinatesForVMLCommentShape]", GetAnchorCoordinatesForVMLCommentShape(CellReference))
commentVmlXml = commentVmlXml.Replace("[RowIndex]", (GetIndexesFromCellReference(CellReference).RowIndex - 1).ToString())
commentVmlXml = commentVmlXml.Replace("[ColumnIndex]", (GetIndexesFromCellReference(CellReference).ColumnIndex - 1).ToString())
Return commentVmlXml
End Function
Public Shared Function GetNoteVMLShapeXML(CellReference As String, CommentCount As Integer)
Dim commentVmlXml As String = String.Empty
commentVmlXml = <![CDATA[
<v:shape id="[ShapeID]" type="#_x0000_t202" style='position:absolute; margin-left:59.25pt; margin-top:1.5pt; width:108pt; height:59.25pt; z-index:1; visibility:hidden' fillcolor="#ffffe1" o:insetmode="auto">
<v:fill color2="#ffffe1" />
<v:shadow on="t" color="black" obscured="t" />
<v:path o:connecttype="none" />
<v:textbox style='mso-fit-shape-to-text:true'>
<div style='text-align:left'></div>
</v:textbox>
<x:ClientData ObjectType="Note">
<x:MoveWithCells />
<x:SizeWithCells />
<x:Anchor>[CoordinatesForVMLCommentShape]</x:Anchor>
<x:AutoFill>False</x:AutoFill>
<x:Row>[RowIndex]</x:Row>
<x:Column>[ColumnIndex]</x:Column>
</x:ClientData>
</v:shape>
]]>.Value.Trim()
Dim ShapeId As String = "_x0000_s" & (1109 + CommentCount + 1).ToString()
commentVmlXml = commentVmlXml.Replace("[ShapeID]", ShapeId)
commentVmlXml = commentVmlXml.Replace("[CoordinatesForVMLCommentShape]", GetAnchorCoordinatesForVMLCommentShape(CellReference))
commentVmlXml = commentVmlXml.Replace("[RowIndex]", (GetIndexesFromCellReference(CellReference).RowIndex - 1).ToString())
commentVmlXml = commentVmlXml.Replace("[ColumnIndex]", (GetIndexesFromCellReference(CellReference).ColumnIndex - 1).ToString())
Return commentVmlXml
End Function
Public Shared Function GetAnchorCoordinatesForVMLCommentShape(CellReference As String) As String
Dim coordinates As String = String.Empty
Dim startingRow As Integer = 0
Dim startingColumn As Integer = GetIndexesFromCellReference(CellReference).ColumnIndex - 1
'From upper right coordinate of a rectangle
'[0] Left column
'[1] Left column offset
'[2] Left row
'[3] Left row offset
'To bottom right coordinate of a rectangle
'[4] Right column
'[5] Right column offset
'[6] Right row
'[7] Right row offset
Dim coordList As List(Of Integer) = {0, 0, 0, 0, 0, 0, 0, 0}.ToList()
If Integer.TryParse(GetIndexesFromCellReference(CellReference).RowIndex, startingRow) Then
startingRow -= 1
coordList(0) = startingColumn + 1
coordList(1) = 15
coordList(2) = startingRow
coordList(4) = startingColumn + 3
coordList(5) = 15
coordList(6) = startingRow + 3
If startingRow = 0 Then
coordList(3) = 2
coordList(7) = 16
Else
coordList(3) = 10
coordList(7) = 4
End If
coordinates = String.Join(",", coordList.ConvertAll(Of String)(Function(X) X.ToString()).ToArray())
End If
Return coordinates
End Function
Public Shared Function GetIndexesFromCellReference(CellReference As String) As CellReferenceIndexes
Dim CellReferenceInfo As New CellReferenceIndexes
Dim ColRef As String = ""
For Each C As Char In CellReference
If Not IsNumeric(C) Then
ColRef &= C
Else
Exit For
End If
Next
ColRef = ColRef.ToUpper()
CellReferenceInfo.RowIndex = Strings.Right(CellReference, CellReference.Length - ColRef.Length)
Dim ColIndex As Integer = 0
For Idx As Integer = 0 To ColRef.Length - 1
ColIndex *= 26
Dim charA As Integer = Asc("A")
Dim charColLetter As Integer = Asc(ColRef(Idx))
ColIndex += (charColLetter - charA) + 1
Next
CellReferenceInfo.ColumnIndex = ColIndex
Return CellReferenceInfo
End Function
Public Shared Sub AddNote(DocInfo As ExcelDocInfo, XCell As Cell, XAuthor As String, Comment As String, Optional XFontName As String = "Tahoma", Optional FontSize As Double = 11, Optional FontBold As Boolean = False, Optional FontItalic As Boolean = False, Optional TextColor As System.Drawing.Color = Nothing, Optional HighlightColor As System.Drawing.Color = Nothing)
If DocInfo Is Nothing Then
Exit Sub
End If
If XCell Is Nothing Then
Exit Sub
End If
If String.IsNullOrEmpty(XAuthor) Then
Exit Sub
End If
If String.IsNullOrEmpty(Comment) Then
Exit Sub
End If
If TextColor = Nothing Then TextColor = System.Drawing.Color.Black
Dim CommentsPart As WorksheetCommentsPart = Nothing
If DocInfo.WSPart.WorksheetCommentsPart Is Nothing Then
CommentsPart = DocInfo.WSPart.AddNewPart(Of WorksheetCommentsPart)
Else
CommentsPart = DocInfo.WSPart.WorksheetCommentsPart()
End If
Dim XComments As Comments = CommentsPart.Comments
If XComments Is Nothing Then
XComments = New Comments() With {.MCAttributes = New MarkupCompatibilityAttributes() With {.Ignorable = "xr"}}
XComments.AddNamespaceDeclaration("mc", "http://schemas.openxmlformats.org/markup-compatibility/2006")
XComments.AddNamespaceDeclaration("xr", "http://schemas.microsoft.com/office/spreadsheetml/2014/revision")
CommentsPart.Comments = XComments
End If
Dim XAuthors As Authors = XComments.GetFirstChild(Of Authors)
If XAuthors Is Nothing Then
XAuthors = New Authors()
XComments.Append(XAuthors)
End If
Dim XLAuthor As Author = (From A As Author In XAuthors.ToList() Where A.Text = XAuthor).FirstOrDefault()
If XLAuthor Is Nothing Then
XLAuthor = New Author() With {.Text = XAuthor}
XAuthors.Append(XLAuthor)
End If
Dim AuthorID As UInt32 = Convert.ToUInt32(XAuthors.AsEnumerable.ToList().IndexOf(XLAuthor))
Dim CommList As CommentList = XComments.GetFirstChild(Of CommentList)
If CommList Is Nothing Then
CommList = New CommentList()
XComments.Append(CommList)
End If
Dim XComment As Comment = XComments.CommentList.AppendChild(Of Comment)(New Spreadsheet.Comment() With {
.AuthorID = New UInt32Value(AuthorID),
.Reference = XCell.CellReference,
.ShapeId = New UInt32Value(Convert.ToUInt32(0))
})
Dim XCommentText As New CommentText()
Dim XRun As New Run()
Dim XRunProperties As New RunProperties()
Dim XFontSize As New FontSize() With {.Val = New DoubleValue(Convert.ToDouble(FontSize))}
Dim XColor As New Color() With {.Rgb = New HexBinaryValue With {.Value = System.Drawing.ColorTranslator.ToHtml(System.Drawing.Color.FromArgb(TextColor.ToArgb())).Replace("#", "")}}
Dim XFillColor As Color = Nothing
If HighlightColor <> Nothing Then
XFillColor = New Color() With {.Rgb = New HexBinaryValue With {.Value = System.Drawing.ColorTranslator.ToHtml(System.Drawing.Color.FromArgb(HighlightColor.ToArgb())).Replace("#", "")}}
End If
Dim XRunFont As New RunFont With {.Val = New StringValue(XFontName)}
Dim XRunBold As New Bold() With {.Val = New BooleanValue(FontBold)}
Dim XRunItalic As New Italic() With {.Val = New BooleanValue(FontItalic)}
Dim xRunPropertyCharSet As New RunPropertyCharSet() With {.Val = New Int32Value(Convert.ToInt32(1))}
XRunProperties.Append(XFontSize)
XRunProperties.Append(XColor)
If XFillColor IsNot Nothing Then
XRunProperties.Append(XFillColor)
End If
XRunProperties.Append(XRunFont)
XRunProperties.Append(XRunBold)
XRunProperties.Append(XRunItalic)
XRunProperties.Append(xRunPropertyCharSet)
Dim XText As New Text() With {.Space = SpaceProcessingModeValues.Preserve, .Text = Comment}
XRun.Append(XRunProperties)
XRun.Append(XText)
XCommentText.Append(XRun)
XComment.Append(XCommentText)
Dim DrawingPartList As List(Of VmlDrawingPart) = DocInfo.WSPart.VmlDrawingParts.ToList()
Dim CommentCount As Integer = 0
Dim DrawingPart As VmlDrawingPart = DocInfo.WSPart.GetPartsOfType(Of VmlDrawingPart)().FirstOrDefault()
Dim Writer As XmlTextWriter = Nothing
Dim DrawingPartStream As Stream = Nothing
Dim SR As StreamReader = Nothing
If DrawingPart Is Nothing Then
DrawingPart = DocInfo.WSPart.AddNewPart(Of VmlDrawingPart)()
DrawingPartStream = DrawingPart.GetStream(IO.FileMode.Create)
SR = New StreamReader(DrawingPartStream)
Writer = New XmlTextWriter(DrawingPartStream, Encoding.UTF8)
Dim XMLText As String = <![CDATA[
<xml xmlns:v="urn:schemas-microsoft-com:vml" xmlns:o=\"urn:schemas-microsoft-com:office:office" xmlns:x="urn:schemas-microsoft-com:office:excel">
<o:shapelayout v:ext="edit">
<o:idmap v:ext="edit" data="1" />
</o:shapelayout>
<v:shapetype id="_x0000_t202" coordsize="21600,21600" o:spt="202" path="m,l,21600r21600,l21600,xe">
<v:stroke joinstyle="miter"/>
<v:path gradientshapeok="t" o:connecttype="rect" />
</v:shapetype>
]]>.Value.Trim()
Writer.WriteRaw(XMLText)
Writer.Flush()
DocInfo.WSPart.Worksheet.AddNamespaceDeclaration("xdr", "http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing")
DocInfo.WSPart.Worksheet.AddNamespaceDeclaration("x14", "http://schemas.microsoft.com/office/spreadsheetml/2009/9/main")
Dim PartID As String = DocInfo.WSPart.GetIdOfPart(DrawingPart)
Dim XLegacyDrawing As LegacyDrawing = New LegacyDrawing() With {.Id = PartID}
DocInfo.WSPart.Worksheet.Append(XLegacyDrawing)
Else
DrawingPartStream = DrawingPart.GetStream()
SR = New StreamReader(DrawingPartStream)
Dim ReadText As String = SR.ReadToEnd()
Dim MatchColl As MatchCollection = Nothing
Dim MatchPattern As New Regex("\<v:shape ")
MatchColl = MatchPattern.Matches(ReadText)
CommentCount = MatchColl.Count
MatchColl = Nothing
MatchPattern = Nothing
Writer = New XmlTextWriter(DrawingPartStream, Encoding.UTF8)
End If
Dim commentsVmlXml As String = String.Empty
commentsVmlXml = GetNoteVMLShapeXML(XCell.CellReference.Value, CommentCount)
Writer.WriteRaw(commentsVmlXml)
Writer.Flush()
Writer.Close()
Writer.Dispose()
Writer = Nothing
SR.Close()
SR.Dispose()
DrawingPartStream.Close()
DrawingPartStream.Dispose()
End Sub
Public Shared Sub AddThreadedComment(DocInfo As ExcelDocInfo, XCell As Cell, XAuthor As String, Comment As String)
If DocInfo Is Nothing Then
Exit Sub
End If
If XCell Is Nothing Then
Exit Sub
End If
If String.IsNullOrEmpty(XAuthor) Then
Exit Sub
End If
If String.IsNullOrEmpty(Comment) Then
Exit Sub
End If
Dim CommentsPart As WorksheetCommentsPart = Nothing
If DocInfo.WSPart.WorksheetCommentsPart Is Nothing Then
CommentsPart = DocInfo.WSPart.AddNewPart(Of WorksheetCommentsPart)
Else
CommentsPart = DocInfo.WSPart.WorksheetCommentsPart()
End If
Dim XComments As Comments = CommentsPart.Comments
If XComments Is Nothing Then
XComments = New Comments() With {.MCAttributes = New MarkupCompatibilityAttributes() With {.Ignorable = "xr"}}
XComments.AddNamespaceDeclaration("mc", "http://schemas.openxmlformats.org/markup-compatibility/2006")
XComments.AddNamespaceDeclaration("xr", "http://schemas.microsoft.com/office/spreadsheetml/2014/revision")
CommentsPart.Comments = XComments
End If
Dim PersPart As WorkbookPersonPart = DocInfo.WBPart.GetPartsOfType(Of WorkbookPersonPart).FirstOrDefault()
If PersPart Is Nothing Then
PersPart = DocInfo.WBPart.AddNewPart(Of WorkbookPersonPart)
End If
Dim PersList As PersonList = PersPart.PersonList
If PersList Is Nothing Then
PersList = New PersonList
PersList.AddNamespaceDeclaration("x", "http://schemas.openxmlformats.org/spreadsheetml/2006/main")
PersPart.PersonList = PersList
End If
Dim Pers As Person = (From P As Person In PersList.AsEnumerable() Where P.DisplayName.Value = XAuthor Select P).FirstOrDefault()
If Pers Is Nothing Then
Pers = New Person() With {.DisplayName = New StringValue(XAuthor), .Id = New StringValue("{" & Guid.NewGuid().ToString().ToUpper() & "}"), .UserId = New StringValue(XAuthor), .ProviderId = New StringValue("None")}
PersList.Append(Pers)
End If
Dim XAuthors As Authors = XComments.GetFirstChild(Of Authors)
If XAuthors Is Nothing Then
XAuthors = New Authors()
XComments.Append(XAuthors)
End If
Dim AuthorGUID As String = "{" & Guid.NewGuid().ToString() & "}"
Dim XLAuthor As Author = New Author() With {.Text = "tc=" & AuthorGUID}
XAuthors.Append(XLAuthor)
Dim WSThreadedCommentsPart As WorksheetThreadedCommentsPart = DocInfo.WSPart.WorksheetThreadedCommentsParts.FirstOrDefault()
If WSThreadedCommentsPart Is Nothing Then
WSThreadedCommentsPart = DocInfo.WSPart.AddNewPart(Of WorksheetThreadedCommentsPart)
End If
Dim XThreadedComments As ThreadedComments = WSThreadedCommentsPart.ThreadedComments
If XThreadedComments Is Nothing Then
XThreadedComments = New ThreadedComments()
WSThreadedCommentsPart.ThreadedComments = XThreadedComments
End If
Dim XThreadedComment As ThreadedComment = New ThreadedComment() With {.Ref = New StringValue(XCell.CellReference), .DT = New DateTimeValue(Now().ToUniversalTime()), .PersonId = Pers.Id, .Id = New StringValue(AuthorGUID)}
Dim XThreadedCommentText As New ThreadedCommentText(Comment)
XThreadedComment.Append(XThreadedCommentText)
XThreadedComments.Append(XThreadedComment)
Dim AuthorID As UInt32 = Convert.ToUInt32(XAuthors.ToList().IndexOf(XLAuthor))
Dim CommList As CommentList = XComments.GetFirstChild(Of CommentList)
If CommList Is Nothing Then
CommList = New CommentList()
XComments.Append(CommList)
End If
Dim XComment As Comment = XComments.CommentList.AppendChild(Of Comment)(New Spreadsheet.Comment() With {
.AuthorID = New UInt32Value(AuthorID),
.Reference = XCell.CellReference,
.ShapeId = New UInt32Value(Convert.ToUInt32(0))
})
XComment.SetAttribute(New OpenXmlAttribute("uid", "http://schemas.microsoft.com/office/spreadsheetml/2014/revision", Pers.Id.Value))
Dim Prepend As String = "[Threaded comment]
Your version of Excel allows you to read this threaded comment; however, any edits to it will get removed if the file is opened in a newer version of Excel. Learn more: https://go.microsoft.com/fwlink/?linkid=870924
Comment:
"
Dim XCommentText As New CommentText()
Dim XText As New Text() With {.Text = Prepend & Comment}
XCommentText.Append(XText)
XComment.Append(XCommentText)
Dim DrawingPartList As List(Of VmlDrawingPart) = DocInfo.WSPart.VmlDrawingParts.ToList()
Dim CommentCount As Integer = 0
Dim DrawingPart As VmlDrawingPart = DocInfo.WSPart.GetPartsOfType(Of VmlDrawingPart)().FirstOrDefault()
Dim Writer As XmlTextWriter = Nothing
Dim DrawingPartStream As Stream = Nothing
Dim SR As StreamReader = Nothing
If DrawingPart Is Nothing Then
DrawingPart = DocInfo.WSPart.AddNewPart(Of VmlDrawingPart)()
DrawingPartStream = DrawingPart.GetStream(IO.FileMode.Create)
SR = New StreamReader(DrawingPartStream)
Writer = New XmlTextWriter(DrawingPartStream, Encoding.UTF8)
Dim XMLText As String = <![CDATA[
<xml xmlns:v="urn:schemas-microsoft-com:vml" xmlns:o=\"urn:schemas-microsoft-com:office:office" xmlns:x="urn:schemas-microsoft-com:office:excel">
<o:shapelayout v:ext="edit">
<o:idmap v:ext="edit" data="1" />
</o:shapelayout>
<v:shapetype id="_x0000_t202" coordsize="21600,21600" o:spt="202" path="m,l,21600r21600,l21600,xe">
<v:stroke joinstyle="miter"/>
<v:path gradientshapeok="t" o:connecttype="rect" />
</v:shapetype>
]]>.Value.Trim()
Writer.WriteRaw(XMLText)
Writer.Flush()
DocInfo.WSPart.Worksheet.AddNamespaceDeclaration("xdr", "http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing")
DocInfo.WSPart.Worksheet.AddNamespaceDeclaration("x14", "http://schemas.microsoft.com/office/spreadsheetml/2009/9/main")
Dim PartID As String = DocInfo.WSPart.GetIdOfPart(DrawingPart)
Dim XLegacyDrawing As LegacyDrawing = New LegacyDrawing() With {.Id = PartID}
DocInfo.WSPart.Worksheet.Append(XLegacyDrawing)
Else
DrawingPartStream = DrawingPart.GetStream()
SR = New StreamReader(DrawingPartStream)
Dim ReadText As String = SR.ReadToEnd()
Dim MatchColl As MatchCollection = Nothing
Dim MatchPattern As New Regex("\<v:shape ")
MatchColl = MatchPattern.Matches(ReadText)
CommentCount = MatchColl.Count
MatchColl = Nothing
MatchPattern = Nothing
Writer = New XmlTextWriter(DrawingPartStream, Encoding.UTF8)
End If
Dim commentsVmlXml As String = String.Empty
commentsVmlXml = GetThreadedCommentVMLShapeXML(XCell.CellReference.Value, CommentCount)
Writer.WriteRaw(commentsVmlXml)
Writer.Flush()
Writer.Close()
Writer.Dispose()
Writer = Nothing
SR.Close()
SR.Dispose()
DrawingPartStream.Close()
DrawingPartStream.Dispose()
End Sub
Public Shared Sub FinalizeComments(DocInfo As ExcelDocInfo)
Dim DrawingPart As VmlDrawingPart = DocInfo.WSPart.GetPartsOfType(Of VmlDrawingPart)().FirstOrDefault()
If DrawingPart IsNot Nothing Then
Using DrawingPartStream As Stream = DrawingPart.GetStream()
Using SR As StreamReader = New StreamReader(DrawingPartStream)
Dim ReadText As String = SR.ReadToEnd()
If Not ReadText.ToLower().EndsWith("</xml>") Then
Using Writer As XmlTextWriter = New XmlTextWriter(DrawingPartStream, Encoding.UTF8)
Writer.WriteRaw("</xml>")
Writer.Flush()
Writer.Close()
End Using
End If
SR.Close()
End Using
DrawingPartStream.Close()
End Using
End If
End Sub
Public Shared Function GetCell(ExcelRow As Row, ColumnNumber As Integer) As Cell
Dim WSCell As Cell = Nothing
If (From C As Cell In ExcelRow.Elements(Of Cell) Where C.CellReference.Value = ExcelColToName(ColumnNumber) & ExcelRow.RowIndex.ToString()).Count > 0 Then
WSCell = (From C As Cell In ExcelRow.Elements(Of Cell) Where C.CellReference.Value = ExcelColToName(ColumnNumber) & ExcelRow.RowIndex.ToString()).FirstOrDefault()
Else
WSCell = New Cell() With {.CellReference = ExcelColToName(ColumnNumber) & ExcelRow.RowIndex.ToString()}
ExcelRow.InsertAt(Of Cell)(WSCell, ExcelRow.Elements(Of Cell).Count)
End If
Return WSCell
End Function
Public Shared Function GetRow(SData As SheetData, RowNumber As Integer) As Row
Dim R As Row = Nothing
Dim RIdx As UInt32Value = Convert.ToUInt32(RowNumber)
If SData.Elements(Of Row).Count > 0 Then
R = (From ERow As Row In SData.Elements(Of Row) Where ERow.RowIndex = RIdx).FirstOrDefault()
End If
If R Is Nothing Then
R = New Row() With {.RowIndex = RIdx}
SData.Append(R)
End If
Return R
End Function
End Class
Public Class TestCase
Public Sub RunTest()
'This sample does not dive into the creation of the spreadsheet. This example focuses strictly on notes and threaded comments.
'In a production example, there would be another sub in the OpenXML class that would populate this ExcelDocInfo object.
'Note that this code will fail as the objects within the DocInfo object currently have no reference to actual objects
Dim DocInfo As New ExcelDocInfo
Dim RowIdx As Integer = 1
Dim ColIdx As Integer = 1
Dim XRow As Row = OpenXML.GetRow(DocInfo.SData, RowIdx)
Dim XCell As Cell = OpenXML.GetCell(XRow, ColIdx)
OpenXML.AddThreadedComment(DocInfo, XCell, "Author Name", "Comment Text Goes Here")
OpenXML.FinalizeComments(DocInfo)
End Sub
End Class