主题：[求助]导出excle图片跑出单元格及图片不居中单元格中间

1、模板

下载信息  [文件大小：   下载次数： ]

点击浏览该文件:会签版现况一致.xlsx

2、代码

Dim Book As New XLS.Book(ProjectPath & "Attachments\会签版现况一致.xlsx")
'Dim fl As String = ProjectPath & "Reports\施工图版物料快速输出.xlsx"
Dim fl As String = "D:\会签版现况一致.xlsx" '指定目标文件
Book.Build() '生成报表
Book.Save(fl)

Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(fl)
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
Dim Rng As MSExcel.Range
Dim Pic As MSExcel.shape

For Each Pic In ws.shapes
    On Error Resume Next
    Dim i As Integer = 0
    output.show(pic.TopLeftCell.address)
    Dim ar() As String = pic.TopLeftCell.address.split("$")
    If ar(1) = "A" Then
        rng =Ws.Range(pic.TopLeftCell, Ws.Cells(ar(2)+2,5))
    Else
        rng =Ws.Range(pic.TopLeftCell, Ws.Cells(ar(2)+14, 9))
    End If
    With Pic
        If .Height / .Width > rng.Height / rng.Width Then
            .Height = rng.Height - 5
            .Top = rng.Top + 2.5
            .Left = rng.Left + (rng.Width - .Width) / 2
            .Placement = 1
        Else
            .Width = rng.Width - 5
            .Left = rng.Left + 2.5
            .Top = rng.Top + (rng.Height - .Height) / 2
            .Placement = 1
        End If
    End With
Next
App.VISIBLE = True
'MessageBox.Show("已经导出EXCLE在 D盘 施工图版物料快速输出.xlsx")

mark excel图片自动比例

Dim Book As New XLS.Book(ProjectPath & "Attachments\会签版三图部分.xlsx")
'Dim fl As String = ProjectPath & "Reports\施工图版物料快速输出.xlsx"
Dim fl As String = "D:\会签版二图部分.xlsx" '指定目标文件
Book.Build() '生成报表
Book.Save(fl)

Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(fl)
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
Dim Rng As MSExcel.Range
Dim Pic As MSExcel.shape

For Each Pic In ws.shapes
    On Error Resume Next
    Dim i As Integer = 0
    rng = pic.TopLeftCell
    Dim width As Double = 0
    Dim height As Double = 0
    If rng.MergeCells Then
        For Each tempcol As object In rng.MergeArea.Columns
            width = width + tempcol.width
        Next
        For Each temprow As object In rng.MergeArea.Rows
            height = height + temprow.height
        Next
    Else
        width = rng.width
        height = rng.height
    End If
    With Pic
        If .Height / .Width > Height / Width Then
            .Height = Height - 5
            .Top = rng.Top + 2.5
            .Left = rng.Left + (Width - .Width) / 2
            .Placement = 1
        Else
            .Width = Width - 5
            .Left = rng.Left + 2.5
            .Top = rng.Top + (Height - .Height) / 2
            .Placement = 1
        End If
    End With
Next
App.VISIBLE = True
'MessageBox.Show("已经导出EXCLE在 D盘 施工图版物料快速输出.xlsx")

单独做个例子发上来测试。