- Foxtable(狐表) (http://foxtable.net/bbs/index.asp)
-- 专家坐堂 (http://foxtable.net/bbs/list.asp?boardid=2)
---- xls自动行高 (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=152554)
-- 发布时间：2020/7/15 9:13:00
-- xls自动行高
此主题相关图片如下：2.png
此主题相关图片如下：1.png
麻烦老师帮忙看看以下代码 设置自动行高后图片就错位了
前面是正确的 越到后面图片错位越严重
\'\'\'...
Dim App As New MSExcel.Application
Dim Wb As MSExcel.Workbook = App.WorkBooks.Open(ProjectPath & "Reports\\合同评审.xls")
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
for j as Integer =0 to dt.DataRows.Count -1
Dim Rg As MSExcel.Range = Ws.Cells( j+5 ,6)
Dim gd As Integer =rg.top
Dim tpk As New List(of String)
tpk = dt.DataRows( j ).Lines("产品图片")
dim k as Integer =tpk.Count
Rg.WrapText = True
Rg.EntireRow.AutoFit \'自动调整行高
Dim p As Integer =0
if k >0 and Rg.RowHeight <80 then
ws.Rows(rg.Row).RowHeight = 80 * (k)
end if
For Each tp As String In tpk
ws.Shapes.AddPicture( "\\\\192.168.1.207\\产品图片$\\" & tp , Microsoft.Office.Core.MsoTriState.msoFalse, Microsoft.Office.Core.MsoTriState.msoTrue,200, gd + p * 80 +5 , 50,50)
p =p+1
Next
next
[此贴子已经被作者于2020/7/15 10:37:58编辑过]
-- 发布时间：2020/7/15 9:28:00
--
先针对整个文档全部调整完行高，再添加图片
-- 发布时间：2020/7/15 9:59:00
--
谢谢 老师 按照您说的我把调整高度和图片分开了 还是会出现错位
此主题相关图片如下：3.png
Dim App As New MSExcel.Application
Dim Wb As MSExcel.Workbook = App.WorkBooks.Open(ProjectPath & "Reports\\合同评审.xls")
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
for j as Integer =0 to dt.DataRows.Count -1
Dim Rg As MSExcel.Range = Ws.Cells( j+7 ,6)
Dim gd As Decimal =rg.top
Dim tpk As New List(of String)
tpk = dt.DataRows( j ).Lines("产品图片")
dim k as Integer =tpk.Count
Rg.WrapText = True
Rg.EntireRow.AutoFit \'自动调整行高
Dim p As Integer =0
if k >0 and Rg.RowHeight <80 then
ws.Rows(rg.Row).RowHeight = 80 * (k)
end if
next
for j as Integer =0 to dt.DataRows.Count -1
Dim Rg As MSExcel.Range = Ws.Cells( j+7 ,6)
Dim gd As Decimal =rg.top
Dim tpk As New List(of String)
tpk = dt.DataRows( j ).Lines("产品图片")
dim k as Integer =tpk.Count
For Each tp As String In tpk
ws.Shapes.AddPicture( "\\\\192.168.1.207\\产品图片$\\" & tp , Microsoft.Office.Core.MsoTriState.msoFalse, Microsoft.Office.Core.MsoTriState.msoTrue,200, gd + p * 80 , 50,50)
p =p+1
Next
next
[此贴子已经被作者于2020/7/15 10:25:12编辑过]
-- 发布时间：2020/7/15 10:10:00
--
意思是针对图片调整高度？
那就不要使用AutoFit自动调整，根据图片高度，手动设置行高RowHeight
-- 发布时间：2020/7/15 10:27:00
--
谢谢老师 已经可以了 要先插入图片 再调整高度
[此贴子已经被作者于2020/7/15 10:37:32编辑过]
-- 发布时间：2020/7/15 10:42:00
--
试试:https://docs.microsoft.com/zh-cn/office/vba/api/excel.xlplacement?view=api-js-preview
Dim img as object
For Each tp As String In tpk
img = ws.Shapes.AddPicture( "\\\\192.168.1.207\\产品图片$\\" & tp , Microsoft.Office.Core.MsoTriState.msoFalse, Microsoft.Office.Core.MsoTriState.msoTrue,200, gd + p * 80 , 50,50)
img.Placement = MSExcel.XlPlacement.xlMoveAndSize
p =p+1
Next