Foxtable(狐表) → 用户栏目 → 专家坐堂 → excel报表中如何获取字体的宽度和高度？


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

主题：excel报表中如何获取字体的宽度和高度？
帅哥哟，离线，有人找我吗？
rjh4078
 小大  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：狐精 帖子：3355 积分：24726 威望：0 精华：0 注册：2012/3/26 21:47:00 		excel报表中如何获取字体的宽度和高度？  发帖心情 Post By：2017/9/22 11:39:00 [显示全部帖子]

如题，如何获取某个单元格里的字体的宽度和高度？

 回到顶部
帅哥哟，离线，有人找我吗？
rjh4078
 小大  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：狐精 帖子：3355 积分：24726 威望：0 精华：0 注册：2012/3/26 21:47:00 		  发帖心情 Post By：2017/9/22 17:28:00 [显示全部帖子]

我想实现自动调整行高 先判断数据字符宽度是否大于单元格 如果大于就将当前行的高度x2

 回到顶部
帅哥哟，离线，有人找我吗？
rjh4078
 小大  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：狐精 帖子：3355 积分：24726 威望：0 精华：0 注册：2012/3/26 21:47:00 		  发帖心情 Post By：2017/9/22 19:34:00 [显示全部帖子]

之前那个解决方案不行 格式全部废掉

 回到顶部
帅哥哟，离线，有人找我吗？
rjh4078
 小大  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：狐精 帖子：3355 积分：24726 威望：0 精华：0 注册：2012/3/26 21:47:00 		  发帖心情 Post By：2017/9/22 20:00:00 [显示全部帖子]

二楼这个判断的是excel单元格字体宽度吗？BaseMainform 不是指窗体吗？
 回到顶部
帅哥哟，离线，有人找我吗？
rjh4078
 小大  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：狐精 帖子：3355 积分：24726 威望：0 精华：0 注册：2012/3/26 21:47:00 		  发帖心情 Post By：2017/9/22 20:15:00 [显示全部帖子]

 Dim Style As XLS.Style = Book.NewStyle() '定义新样式
        style.Font = New Font("楷体",10,FontStyle.Strikeout)
        Style.BorderTop = XLS.LineStyleEnum.Thin
        Style.BorderBottom = XLS.LineStyleEnum.Thin
        Style.BorderLeft = XLS.LineStyleEnum.Thin
        Style.BorderRight = XLS.LineStyleEnum.Thin
        Style.AlignHorz = XLS.AlignHorzEnum.Center
        Style.AlignVert = XLS.AlignVertEnum.Center        
        For i As Integer=0 To sheet.Rows.count-1
            If sheet(i,0).value="Y" Then
                For j As Integer=0 To 17
                    sheet(i,j+1).Style=Style 
                Next
            End If
for k as integer=0 to sheet.cols.count-1 then
如果单元格字符的宽度除以单元格宽度大于t
则将该行行高乘以t并将该单元格自动换行设为true
        Next


这个是写在报表的afterbuild事件中 红色部分如何实现？

[此贴子已经被作者于2017/9/22 20:16:01编辑过]
 回到顶部
帅哥哟，离线，有人找我吗？
rjh4078
 小大  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：狐精 帖子：3355 积分：24726 威望：0 精华：0 注册：2012/3/26 21:47:00 		  发帖心情 Post By：2017/9/22 21:57:00 [显示全部帖子]

 下载信息  [文件大小：   下载次数： ]
图片点击可在新窗口打开查看点击浏览该文件:自动行高打印测试.rar

感谢了 需求写在里面了
 回到顶部
帅哥哟，离线，有人找我吗？
rjh4078
 小大  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：狐精 帖子：3355 积分：24726 威望：0 精华：0 注册：2012/3/26 21:47:00 		  发帖心情 Post By：2017/9/23 12:37:00 [显示全部帖子]

这个只是做了个例子 实际项目比这个要复杂

 回到顶部
帅哥哟，离线，有人找我吗？
rjh4078
 小大  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：狐精 帖子：3355 积分：24726 威望：0 精华：0 注册：2012/3/26 21:47:00 		  发帖心情 Post By：2017/9/23 13:17:00 [显示全部帖子]

蓝版 我将你的代码做了修改

Dim rg As MSExcel.Range
                Dim tempWs = wb.WorkSheets.Add
                Dim tempCell As MSExcel.Range = tempWs.Cells(1, 1)
                Dim Strike As Boolean
                For Each rg In ws.UsedRange
                    If rg.MergeCells AndAlso rg.MergeArea.Columns.count>1 Then

我的意思是如果是合并单元格并且合并列数大于1 就进行后面自动行高的设置

但是执行的时候出现了这样的报错


图片点击可在新窗口打开查看此主题相关图片如下：tim截图20170923131246.png
图片点击可在新窗口打开查看
 回到顶部
帅哥哟，离线，有人找我吗？
rjh4078
 小大  9楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：狐精 帖子：3355 积分：24726 威望：0 精华：0 注册：2012/3/26 21:47:00 		  发帖心情 Post By：2017/9/23 17:17:00 [显示全部帖子]

例子确实没问题 但是代码改了以后放到我的项目里就不行  我只修改了这个判断条件 其他都没改
 Dim rg As MSExcel.Range
                Dim tempWs = wb.WorkSheets.Add
                Dim tempCell As MSExcel.Range = tempWs.Cells(1, 1)
                Dim Strike As Boolean
                For Each rg In ws.UsedRange
                    If rg.MergeCells AndAlso rg.MergeArea.Columns.count>1  Then
                        '' rg.Font.Strikethrough = Strike '设置删除线
                        Dim width As Double = 0
                        Dim tempCol
                        For Each tempcol In rg.MergeArea.Columns
                            width = width + tempcol.ColumnWidth
                        Next
                        tempWs.Columns(1).WrapText = True
                        tempWs.Columns(1).ColumnWidth = width
                        tempWs.Columns(1).Font.Size = rg.Font.Size
                        tempcell.Value = rg.Value
                        tempcell.RowHeight = 0
                        tempcell.EntireRow.Activate
                        tempcell.EntireRow.AutoFit
                        If (rg.RowHeight < tempcell.RowHeight) Then
                            Dim tempHeight As Double
                            Dim tempCount As Integer
                            tempHeight = tempcell.RowHeight
                            tempCount = rg.MergeArea.Rows.Count
                            For Each addHeightRow As object In rg.MergeArea.Rows
                                If (addHeightRow.RowHeight < tempHeight / tempCount) Then
                                    addHeightRow.RowHeight = tempHeight / tempCount + 10
                                End If
                                tempHeight = tempHeight - addHeightRow.RowHeight
                                tempCount = tempCount - 1
                            Next
                            rg.WrapText = True
                        End If
                    End If
                Next
                app.DisplayAlerts = False
                tempWs.Delete
               app.visible = True
            catch ex As exception
                msgbox(ex.message)
                app.quit
            End try
            
 回到顶部
帅哥哟，离线，有人找我吗？
rjh4078
 小大  10楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：狐精 帖子：3355 积分：24726 威望：0 精华：0 注册：2012/3/26 21:47:00 		  发帖心情 Post By：2017/9/23 17:24:00 [显示全部帖子]

找到问题了  写保护导致的  现在产生一个新的问题 不加这个代码生成报表2秒左右 加了代码需要将近1分钟才能生成报表  我看了下进程excel CPU飙到30% 内存飙到100M+

 回到顶部
总数 13 1 2 下一页
RSS2.0 | Xhtml无图版 | Xslt无图版 Copyright © 2000 - 2018 foxtable.com Tel: 4000-810-820 粤ICP备11091905号
   Powered By Dvbbs Version 8.3.0
页面执行时间 0.05469 秒, 6 次数据查询