Dim Book As New XLS.Book(ProjectPath & "Attachments\会签版现况一致.xlsx")
Dim fl As String = ProjectPath & "Reports\会签版现况一致.xlsx"
Dim Sheet As XLS.Sheet = Book.Sheets(0)
'Sheet(3,9).Value = "<列值 = # " & Date.Today & "#>" '写入打印条件
'Sheet(46,10).Value = "<列值 = '0'>" '写入打印条件
Sheet(8,10).Value = "<列值 = '0'>" '写入打印条件
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(2)
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
Dim ar() As String = pic.TopLeftCell.address.split("$")
If ar(1) = "A" Then
i = 22
rng =Ws.Range(pic.TopLeftCell, Ws.Cells(i + val(ar(2)),6))
Output.Show(Ws.Cells(6,i + val(ar(2))).address )
Else
i = 10
rng =Ws.Range(pic.TopLeftCell, Ws.Cells(i + val(ar(2)),9))
End If
'rng = pic.TopLeftCell
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
加好友 
发短信
Post By：2018/4/20 22:44:00 [显示全部帖子]
