Question

附上我的代码以向Excel插入注释。遍历约500行大约需要3分钟。

构建并循环遍历具有单元格引用和注释的字典，以实现目前的功能。

有没有一种方法可以优化我的代码？喜欢，通过使用parallel.foeach？如果是这样，请提及我可以做到的方式。

Public Sub InsertComments(ByVal worksheetPart As WorksheetPart, ByVal commentsToAddDict As Dictionary(Of String, String))
        If commentsToAddDict.Any() Then
            Dim commentsVmlXml As String = String.Empty

            For Each commentToAdd In commentsToAddDict
                Dim colLetters As String() = Regex.Split(commentToAdd.Key, "([A-Z]+)")
                commentsVmlXml += GetCommentVMLShapeXML(colLetters(1), colLetters(2))
            Next

            Dim vmlDrawingPart As VmlDrawingPart = worksheetPart.AddNewPart(Of VmlDrawingPart)()

            Using writer As XmlTextWriter = New XmlTextWriter(vmlDrawingPart.GetStream(FileMode.Create), Encoding.UTF8)
                writer.WriteRaw("<xml xmlns:v=""urn:schemas-microsoft-com:vml""" & vbCrLf & " xmlns:o=""urn:schemas-microsoft-com:office:office""" & vbCrLf & " xmlns:x=""urn:schemas-microsoft-com:office:excel"">" & vbCrLf & " <o:shapelayout v:ext=""edit"">" & vbCrLf & "  <o:idmap v:ext=""edit"" data=""1""/>" & vbCrLf & "</o:shapelayout><v:shapetype id=""_x0000_t202"" coordsize=""21600,21600"" o:spt=""202""" & vbCrLf & "  path=""m,l,21600r21600,l21600,xe"">" & vbCrLf & "  <v:stroke joinstyle=""miter""/>" & vbCrLf & "  <v:path gradientshapeok=""t"" o:connecttype=""rect""/>" & vbCrLf & " </v:shapetype>" & commentsVmlXml & "</xml>")
            End Using

            For Each commentToAdd In commentsToAddDict
                Dim worksheetCommentsPart As WorksheetCommentsPart = If(worksheetPart.WorksheetCommentsPart, worksheetPart.AddNewPart(Of WorksheetCommentsPart)())

                If worksheetPart.Worksheet.Descendants(Of LegacyDrawing)().SingleOrDefault() Is Nothing Then
                    Dim vmlPartId As String = worksheetPart.GetIdOfPart(vmlDrawingPart)
                    Dim legacyDrawing As LegacyDrawing = New LegacyDrawing() With {
                        .Id = vmlPartId
                    }
                    worksheetPart.Worksheet.Append(legacyDrawing)
                End If

                Dim comments As Comments
                Dim appendComments As Boolean = False

                If worksheetPart.WorksheetCommentsPart.Comments IsNot Nothing Then
                    comments = worksheetPart.WorksheetCommentsPart.Comments
                Else
                    comments = New Comments()
                    appendComments = True
                End If

                If worksheetPart.WorksheetCommentsPart.Comments Is Nothing Then
                    Dim authors As Authors = New Authors()
                    Dim author As Author = New Author()
                    author.Text = "Author Name"
                    authors.Append(author)
                    comments.Append(authors)
                End If

                Dim commentList As CommentList
                Dim appendCommentList As Boolean = False

                If worksheetPart.WorksheetCommentsPart.Comments IsNot Nothing AndAlso worksheetPart.WorksheetCommentsPart.Comments.Descendants(Of CommentList)().SingleOrDefault() IsNot Nothing Then
                    commentList = worksheetPart.WorksheetCommentsPart.Comments.Descendants(Of CommentList)().Single()
                Else
                    commentList = New CommentList()
                    appendCommentList = True
                End If

                Dim comment As Comment = New Comment() With {
                    .Reference = commentToAdd.Key,
                    .AuthorId = CType(0UI, UInt32Value)
                }
                Dim commentTextElement As CommentText = New CommentText()
                Dim run As Run = New Run()
                Dim runProperties As RunProperties = New RunProperties()
                Dim bold As Bold = New Bold()
                Dim fontSize As FontSize = New FontSize() With {
                    .Val = 8.0R
                }
                Dim color As Color = New Color() With {
                    .Indexed = CType(81UI, UInt32Value)
                }
                Dim runFont As RunFont = New RunFont() With {
                    .Val = "Tahoma"
                }
                Dim runPropertyCharSet As RunPropertyCharSet = New RunPropertyCharSet() With {
                    .Val = 1
                }
                runProperties.Append(bold)
                runProperties.Append(fontSize)
                runProperties.Append(color)
                runProperties.Append(runFont)
                runProperties.Append(runPropertyCharSet)
                Dim text As Text = New Text()
                text.Text = commentToAdd.Value
                run.Append(runProperties)
                run.Append(text)
                commentTextElement.Append(run)
                comment.Append(commentTextElement)
                commentList.Append(comment)

                If appendCommentList Then
                    comments.Append(commentList)
                End If

                If appendComments Then
                    worksheetCommentsPart.Comments = comments
                End If
            Next
        End If
    End Sub

如何使用openxml将注释的插入优化为excel

0 个答案: