使用documentformat.openxml在xlsm文件中插入图像和文本时出现问题

时间:2013-11-10 15:12:06

标签: vb.net openxml

 'Create a Excel Object
        Using excel As Excel = New Excel(ReportPath, CurrentMapping.Settings)
            ' Create newWorksheet 
            excel.CreateExcelTemplate(ReportPath)

            ' Generate Styles            
            excel.GenerateStyleSheet(Me.Schema)
            excel.SetSheetDataSettings(RowCount, ColumnCount)

            'Open Sheet
            SheetName = ReportHelper.FormatData(InputData, SheetName).Replace("*", String.Empty)
            excel.OpenSheet(SheetName)

            'Fill Column Settings
            excel.AddStartColumnSettings()
            FillColumnSettings(excel, schemaTable)              ' Set Column Width
            excel.AddEndColumnSettings()

            'Start Sheet and Fill Header and Data Header
            excel.AddStartSheetData()
            FillHeader(excel, CurrentMapping.Header)            ' Generate Header
            FillDataHeader(excel, schemaTable)                  ' Generate Data Header

            'Set start row
            If String.IsNullOrEmpty(CurrentMapping.Settings.StartPrintRow) Then
                StartRow = excel.GetRowCount
            Else
                StartRow = CurrentMapping.Settings.StartPrintRow
            End If


            Dim lastRow As DataRow = Nothing
            For Each row As DataRow In reportData.Rows

                'To Generate the Summary Row if Summary is needed
                If Not String.IsNullOrEmpty(CurrentMapping.SummaryBreakColumn) Then
                    If lastRow IsNot Nothing Then
                        For Each spair As String In CurrentMapping.SummaryBreakColumn.Split(","c)
                            Dim dataKey As String = spair.Split("-"c)(0)
                            Dim sumKey As String = spair.Split("-"c)(1)
                            If Not lastRow(dataKey).Equals(row(dataKey)) Then
                                CreateEmptyRow(excel)
                                FillDataHeader(CurrentMapping.SummaryMappings, excel, SummarySchema)
                                For Each dr As DataRow In SummaryData.Rows
                                    If dr(sumKey) = lastRow(dataKey) Then
                                        GenerateRow(CurrentMapping.SummaryMappings, excel, dr, SummarySchema)
                                    End If
                                Next
                                CreateEmptyRow(excel)
                            End If
                        Next
                    End If
                    lastRow = row
                End If

                'Generate the row data
                GenerateRow(excel, row, schemaTable)


 'Close the sheet and write the workbook settings
            excel.AddEndSheetData()
            excel.CloseSheet()
            excel.WorkbookSettings(SheetName, StartRow, excel.RowCount - StartRow, ColumnCount)      'Apply Workbook Settings
            excel.CloseDocument()

我正在创建电子表格并添加标题和列标题,GenerateRow方法会在电子表格中添加行数据。在电子表格特定列中,我附加了文件系统中的图像。

Protected Sub GenerateRow(ByVal excel As Excel, ByVal row As DataRow, ByVal schemaTable As DataTable)
        If EvaluateRowCondition(row).Equals("TRUE") Then
            Dim rowBuilder As New StringBuilder
            excel.AddStartRow(rowBuilder)
            For Each omkey As String In CurrentMapping.OutputMappings.Keys

                If Schema.ToString.Substring(Schema.LastIndexOf("\")) = "\rptSalesProduct.xml" Then
                    For Each cell As Cell In CreateCell(CurrentMapping.OutputMappings(omkey), row, schemaTable)
                        If (row("mainproductpicture").Trim() <> String.Empty) Then
                            excel.AddImgColumn(rowBuilder, cell.Style, cell.DataType, cell.Data, SheetName)
                        Else
                            excel.AddColumn(rowBuilder, cell.Style, cell.DataType, cell.Data)
                        End If
                    Next
                    Continue For
                End If                
            Next
            excel.AddEndRow(rowBuilder)
        End If

        End Sub

在生成行方法中,要调用图像列AddImgColumn方法,并调用数据列AddColumn方法。

Sub AddColumn(ByVal rowBuilder As StringBuilder, ByVal styleId As String, ByVal typeName As String, ByVal data As String)
        'Get the Style Index no by name
        If styleIndex.ContainsKey(styleId) Then
            styleId = styleIndex(styleId)
        Else
            If styleIndex.ContainsKey("DefaultData") Then   'Set style for default data
                styleId = styleIndex("DefaultData")
            Else
                styleId = "0"
            End If
        End If

        'Convert data
        data = System.Web.HttpUtility.HtmlEncode(data)
        If data Is Nothing Then
            data = String.Empty
        End If

        'Write data
        ColumnCount = ColumnCount + 1
        Dim address As String = GetColumnName(ColumnCount) + "" & RowCount
        Select Case typeName
            Case "String"
                rowBuilder.Append(String.Format("<c r=""{0}"" s=""{1}"" t=""str"" ><v>{2}</v></c>", address, styleId, data))
            Case "Number"
                rowBuilder.Append(String.Format("<c r=""{0}"" s=""{1}""  ><v>{2}</v></c>", address, styleId, data))
        End Select
        End Sub

我遇到了AddImgColumn方法的问题,下面是该方法的代码

Sub AddImgColumn(ByVal rowBuilder As StringBuilder, ByVal styleId As String, ByVal typeName As String, ByVal data As String, ByVal sheetName As String)
        'Get the Style Index no by name
        If styleIndex.ContainsKey(styleId) Then
            styleId = styleIndex(styleId)
        Else
            If styleIndex.ContainsKey("DefaultData") Then   'Set style for default data
                styleId = styleIndex("DefaultData")
            Else
                styleId = "0"
            End If
        End If

        'Convert data
        data = System.Web.HttpUtility.HtmlEncode(data)
        If data Is Nothing Then
            data = String.Empty
        End If


        Dim workbookPart As WorkbookPart
        Dim worksheet As Worksheet
        Using mySpreadsheet As SpreadsheetDocument = SpreadsheetDocument.Open(Path, True)
            workbookPart = mySpreadsheet.WorkbookPart
            For Each worksheetPart As WorksheetPart In workbookPart.WorksheetParts
                worksheet = worksheetPart.Worksheet
                InsertImage(worksheet, 1, 1, data)
                worksheetPart.Worksheet.Save()
                Exit For
            Next
        End Using     

        End Sub

在打开电子表格时,我收到错误消息“进程无法访问该文件,因为它被另一个进程使用”。

我需要将工作表的现有实例传递给InsertImage方法来绑定特定单元格中的图像

Protected Shared Sub InsertImage(ByVal ws As Worksheet, ByVal x As Long, ByVal y As Long, ByVal width As System.Nullable(Of Long), ByVal height As System.Nullable(Of Long), ByVal sImagePath As String)
Try
    Dim wsp As WorksheetPart = ws.WorksheetPart
    Dim dp As DrawingsPart
    Dim imgp As ImagePart
    Dim wsd As SP.WorksheetDrawing

    Dim ipt As ImagePartType
    Select Case sImagePath.Substring(sImagePath.LastIndexOf("."c) + 1).ToLower()
        Case "png"
            ipt = ImagePartType.Png
            Exit Select
        Case "jpg", "jpeg"
            ipt = ImagePartType.Jpeg
            Exit Select
        Case "gif"
            ipt = ImagePartType.Gif
            Exit Select
        Case Else
            Return
    End Select

    If wsp.DrawingsPart Is Nothing Then
        '----- no drawing part exists, add a new one   
        dp = wsp.AddNewPart(Of DrawingsPart)()
        imgp = dp.AddImagePart(ipt, wsp.GetIdOfPart(dp))
        wsd = New SP.WorksheetDrawing()
    Else
        '----- use existing drawing part   
        dp = wsp.DrawingsPart
        imgp = dp.AddImagePart(ipt)
        dp.CreateRelationshipToPart(imgp)
        wsd = dp.WorksheetDrawing
    End If

    Using fs As New FileStream(sImagePath, FileMode.Open)
        imgp.FeedData(fs)
    End Using

    Dim imageNumber As Integer = 1 'dp.ImageParts.Count(Of ImagePart)()
    If imageNumber = 1 Then
        Dim drawing As New Drawing()
        drawing.Id = dp.GetIdOfPart(imgp)
        ws.Append(drawing)
    End If

    Dim nvdp As New SP.NonVisualDrawingProperties()
    nvdp.Id = New UInt32Value(CUInt(1024 + imageNumber))
    nvdp.Name = "Picture " & imageNumber.ToString()
    nvdp.Description = ""
    Dim picLocks As New DocumentFormat.OpenXml.Drawing.PictureLocks()
    picLocks.NoChangeAspect = True
    picLocks.NoChangeArrowheads = True
    Dim nvpdp As New SP.NonVisualPictureDrawingProperties()
    nvpdp.PictureLocks = picLocks
    Dim nvpp As New SP.NonVisualPictureProperties()
    nvpp.NonVisualDrawingProperties = nvdp
    nvpp.NonVisualPictureDrawingProperties = nvpdp

    Dim stretch As New DocumentFormat.OpenXml.Drawing.Stretch()
    stretch.FillRectangle = New DocumentFormat.OpenXml.Drawing.FillRectangle()
    Dim blipFill As New SP.BlipFill()
    Dim blip As New DocumentFormat.OpenXml.Drawing.Blip()
    blip.Embed = dp.GetIdOfPart(imgp)
    blip.CompressionState = DocumentFormat.OpenXml.Drawing.BlipCompressionValues.Print
    blipFill.Blip = blip
    blipFill.SourceRectangle = New DocumentFormat.OpenXml.Drawing.SourceRectangle()
    blipFill.Append(stretch)
    Dim t2d As New DocumentFormat.OpenXml.Drawing.Transform2D()
    Dim offset As New DocumentFormat.OpenXml.Drawing.Offset()
    offset.X = 0
    offset.Y = 0
    t2d.Offset = offset
    Dim bm As New Bitmap(sImagePath)
    Dim extents As New DocumentFormat.OpenXml.Drawing.Extents()
    If width Is Nothing Then
        extents.Cx = CLng(bm.Width) * CLng(System.Math.Truncate(CDbl(914400) / bm.HorizontalResolution))
    Else
        extents.Cx = width
    End If
    If height Is Nothing Then
        extents.Cy = CLng(bm.Height) * CLng(System.Math.Truncate(CDbl(914400) / bm.VerticalResolution))
    Else
        extents.Cy = height
    End If

    bm.Dispose()
    t2d.Extents = extents
    Dim sp As New SP.ShapeProperties()
    sp.BlackWhiteMode = DocumentFormat.OpenXml.Drawing.BlackWhiteModeValues.Auto
    sp.Transform2D = t2d
    Dim prstGeom As New DocumentFormat.OpenXml.Drawing.PresetGeometry()
    prstGeom.Preset = DocumentFormat.OpenXml.Drawing.ShapeTypeValues.Rectangle
    prstGeom.AdjustValueList = New DocumentFormat.OpenXml.Drawing.AdjustValueList()
    sp.Append(prstGeom)
    sp.Append(New DocumentFormat.OpenXml.Drawing.NoFill())

    Dim picture As New DocumentFormat.OpenXml.Drawing.Spreadsheet.Picture()
    picture.NonVisualPictureProperties = nvpp
    picture.BlipFill = blipFill
    picture.ShapeProperties = sp

    Dim pos As New SP.Position()
    pos.X = x
    pos.Y = y
    Dim ext As New SP.Extent()
    ext.Cx = extents.Cx
    ext.Cy = extents.Cy
    Dim anchor As New SP.AbsoluteAnchor()
    anchor.Position = pos
    anchor.Extent = ext
    anchor.Append(picture)
    anchor.Append(New SP.ClientData())
    wsd.Append(anchor)
    wsd.Save(dp)

Catch ex As Exception
    ' or do something more interesting if you want  
    'Throw ex 
End Try
End Sub

Protected Shared Sub InsertImage(ByVal ws As Worksheet, ByVal x As Long, ByVal y As Long, ByVal sImagePath As String)
    InsertImage(ws, x, y, Nothing, Nothing, sImagePath)
End Sub

请提供一些解决方案,以使其发挥作用。

由于 曼居拉

0 个答案:

没有答案