Dim djna As String=args(0) ''第一个参数 单据名
vars("文件路径")=""
With Tables(args(1))
If .current IsNot Nothing Then
Dim lj As String=Functions.Execute("打印模板缓存",djna)
If lj<>"" Then
Dim Book As New XLS.Book(lj)
Dim fl As String =lj.Replace("Attachments","Reports")
Book.Build() '生成细节区
Book.Save(fl)
Dim App As New MSExcel.Application
try
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(fl)
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1) ''start
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
catch ex As exception
msgbox(ex.message)
app.quit
End try
End If
End If
End With
[此贴子已经被作者于2018/9/25 13:09:06编辑过]
加好友 
发短信
Post By：2018/9/21 22:51:00 [只看该作者]
此主题相关图片如下：1.png
