Foxtable(狐表)用户栏目专家坐堂 → [求助]报表单元格图片尺寸,怎么适应单元格


  共有3715人关注过本帖树形打印复制链接

主题:[求助]报表单元格图片尺寸,怎么适应单元格

帅哥哟,离线,有人找我吗?
湛江智
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:四尾狐 帖子:812 积分:6676 威望:0 精华:0 注册:2014/11/26 12:32:00
[求助]报表单元格图片尺寸,怎么适应单元格  发帖心情 Post By:2018/4/20 16:55:00 [只看该作者]


图片点击可在新窗口打开查看此主题相关图片如下:控制图片高度,宽度超出excle报表单元格.jpg
图片点击可在新窗口打开查看

 

[&图片1, 39,12,-1,290]控制图片高度,宽度超出excle报表单元格

[&图片1, 39,12,290,-1] 控制图片宽度,高度超出excle报表单元格

怎么解决图片在单元格中饱满不能太小,又不跑出单元格外面?



图片点击可在新窗口打开查看此主题相关图片如下:控制图片宽度,高度超出excle报表单元格.jpg
图片点击可在新窗口打开查看


 


 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2018/4/20 17:05:00 [只看该作者]

根据单元格的宽高设置图片的宽高,参考

 

Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open("d:\test.xls")
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
   
    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

[此贴子已经被作者于2018/4/20 17:05:38编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
湛江智
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:四尾狐 帖子:812 积分:6676 威望:0 精华:0 注册:2014/11/26 12:32:00
回复:(有点甜)根据单元格的宽高设置图片的宽高,参...  发帖心情 Post By:2018/4/20 17:35:00 [只看该作者]

老师,这个代码添加在哪个事件里呢?

我用的是excle模板作报表按钮下面的代码:

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 Proc As New Process
Proc.File = fl
Proc.Start()


 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2018/4/20 17:54:00 [只看该作者]

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(1)
Dim Rng As MSExcel.Range
Dim Pic As MSExcel.shape


For Each Pic In ws.shapes
    On Error Resume Next
   
    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


 回到顶部
帅哥哟,离线,有人找我吗?
湛江智
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:四尾狐 帖子:812 积分:6676 威望:0 精华:0 注册:2014/11/26 12:32:00
回复:(有点甜)Dim Book As New XLS.Book(ProjectPa...  发帖心情 Post By:2018/4/20 18:05:00 [只看该作者]

上面代码没效果的,图片还是跑出单元格(多行单元格合并的单元格)外面。

[&图片1, 39,12,-1,290]

[&图片1, 39,12,290,-1]

单元格里,上面的代码是否要调整?

[此贴子已经被作者于2018/4/20 18:05:57编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2018/4/20 18:20:00 [只看该作者]

不,可,能。上传实例测试。


 回到顶部
帅哥哟,离线,有人找我吗?
湛江智
  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:四尾狐 帖子:812 积分:6676 威望:0 精华:0 注册:2014/11/26 12:32:00
回复:(有点甜)不,可,能。上传实例测试。  发帖心情 Post By:2018/4/20 20:43:00 [只看该作者]

图片跑出单元格,项目,老师请下载帮忙看看

 

 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:图片跑出单元格.rar


 回到顶部
帅哥,在线噢!
有点蓝
  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:106008 积分:539127 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2018/4/20 22:44:00 [只看该作者]

模板有问题,有一个默认的Macro1页,所以生成的文件是第二个sheet


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

 回到顶部
帅哥哟,离线,有人找我吗?
湛江智
  9楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:四尾狐 帖子:812 积分:6676 威望:0 精华:0 注册:2014/11/26 12:32:00
  发帖心情 Post By:2018/4/21 1:06:00 [只看该作者]

谢老师了

 回到顶部
帅哥哟,离线,有人找我吗?
湛江智
  10楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:四尾狐 帖子:812 积分:6676 威望:0 精华:0 注册:2014/11/26 12:32:00
回复:(有点蓝)模板有问题,有一个默认的Macro1页,...  发帖心情 Post By:2018/7/4 15:31:00 [只看该作者]

已解决,谢谢老师
[此贴子已经被作者于2018/7/6 9:57:41编辑过]

 回到顶部
总数 11 1 2 下一页