设为首页收藏本站
简字体切换切换到宽版

ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步，快速开始

快捷登录

搜索
ExcelHome技术论坛»论坛 › Excel 技术交流与问答 › Excel VBA程序开发 › 关于EXCEL的智能排版设置（VBA打印设置）
EH技术汇-专业的职场技能充电站 妙哉！函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
12下一页
返回列表 发新帖
查看: 6834|回复: 11

[原创] 关于EXCEL的智能排版设置（VBA打印设置）

[复制链接]
atday

TA的精华主题

TA的得分主题
发表于 2013-1-13 22:07 | 显示全部楼层 |阅读模式
[广告] ★ExcelHome默写助手 - 不用妈妈陪的默写神器 · Word/WPS插件 · 自定义默写单 · 自定义描红字帖★

复制代码
把附件放置VBA加载项，右键会出现以上菜单。
做了几天，现在与大家分享
主要功能：选中区域，则针对选中区域排版，否则，针对整个工作薄排版。
自动计算，以最合适的设置排版。
AutoFit-Lite.rar (20.48 KB, 下载次数: 368)

计算, 关于, excel, 智能, 排版
未命名.jpg
回复

举报

atday

TA的精华主题

TA的得分主题
 楼主| 发表于 2013-1-13 22:08 | 显示全部楼层
[广告] ★用Excel做企业管理系统，Excel服务器学习和下载★
本帖最后由 atday 于 2013-1-13 22:10 编辑
  1. Sub AutoPrint() '智能排版设置 BY 小李 注：选中区域，则针对选中区域排版，否则，针对整个工作薄排版
  2. Dim Dy, Col, i, ii As Double
  3. Dim Din As Variant
  4. 'On Error Resume Next '错误跳过
  5. Application.ScreenUpdating = False '关闭屏幕刷新

  7. If Selection.Count <> 1 Then '以下对工作表选定设置排版

  9. Dy = ActiveSheet.UsedRange.Count
  10. Din = Selection.Address 'SpecialCells(xlCellTypeVisible)
  11. ActiveSheet.PageSetup.PrintArea = Din 'ActiveSheet设置自动打印有数据的范围
  12. 'ActiveSheet.Range("A4:A1000").SpecialCells(xlCellTypeVisible).EntireRow.AutoFit '设置自动行高Rows(A1000).End(xlUp)
  13. Col = Range(Din).EntireColumn.Width 'Width：返回的是以磅为单位的值


  16. Select Case Col
  17.     Case Is < 600
  18.     With ActiveSheet.PageSetup '初始设置
  19.         .LeftMargin = Application.InchesToPoints(0.708661417322835) '左边距
  20.         .RightMargin = Application.InchesToPoints(0.708661417322835) '右边距
  21.         .TopMargin = Application.InchesToPoints(0.590551181102362) '上边距
  22.         .BottomMargin = Application.InchesToPoints(0.590551181102362) '下边距
  23.         .HeaderMargin = Application.InchesToPoints(0.31496062992126) '页眉边距
  24.         .FooterMargin = Application.InchesToPoints(0.31496062992126) '页脚边距
  25.         .CenterHorizontally = True '水平居中
  26.         '.CenterVertically = False '垂直居中
  27.         .Orientation = xlPortrait '页面纵向
  28.         '.Orientation = xlLandscape '页面横向
  29.         .Draft = False
  30.         .PaperSize = xlPaperA4 'A4纸
  31.         .BlackAndWhite = False '是否黑白打印
  32.         .Zoom = False '是否缩放模式
  33.         .FitToPagesWide = 1
  34.         .FitToPagesTall = 200
  35.     End With
  36.     ActiveWindow.View = xlPageBreakPreview '打印模式窗口
  37.     ActiveWindow.Zoom = 100 '窗口缩放大小
  38.     Case Is < 735
  39.     With ActiveSheet.PageSetup '初始设置
  40.         .LeftMargin = Application.InchesToPoints(0.393700787401575) '左边距
  41.         .RightMargin = Application.InchesToPoints(0.393700787401575) '右边距
  42.         .TopMargin = Application.InchesToPoints(0.393700787401575) '上边距
  43.         .BottomMargin = Application.InchesToPoints(0.393700787401575) '下边距
  44.         .HeaderMargin = Application.InchesToPoints(0.31496062992126) '页眉边距
  45.         .FooterMargin = Application.InchesToPoints(0.31496062992126) '页脚边距
  46.         .CenterHorizontally = True '水平居中
  47.         '.CenterVertically = False '垂直居中
  48.         .Orientation = xlPortrait '页面纵向
  49.         '.Orientation = xlLandscape '页面横向
  50.         .Draft = False
  51.         .PaperSize = xlPaperA4 'A4纸
  52.         .BlackAndWhite = False '是否黑白打印
  53.         .Zoom = False '是否缩放模式
  54.         .FitToPagesWide = 1
  55.         .FitToPagesTall = 200
  56.     End With
  57.     ActiveWindow.View = xlPageBreakPreview '打印模式窗口
  58.     ActiveWindow.Zoom = 100 '窗口缩放大小
  59.    
  60.          Case Is < 900
  61.     With ActiveSheet.PageSetup '初始设置
  62.         .LeftMargin = Application.InchesToPoints(0.708661417322835) '左边距
  63.         .RightMargin = Application.InchesToPoints(0.708661417322835) '右边距
  64.         .TopMargin = Application.InchesToPoints(0.393700787401575) '上边距
  65.         .BottomMargin = Application.InchesToPoints(0.393700787401575) '下边距
  66.         .HeaderMargin = Application.InchesToPoints(0.31496062992126) '页眉边距
  67.         .FooterMargin = Application.InchesToPoints(0.31496062992126) '页脚边距
  68.         .CenterHorizontally = True '水平居中
  69.         '.CenterVertically = False '垂直居中
  70.         '.Orientation = xlPortrait '页面纵向
  71.         .Orientation = xlLandscape '页面横向
  72.         .Draft = False
  73.         .PaperSize = xlPaperA4 'A4纸
  74.         .BlackAndWhite = False '是否黑白打印
  75.         .Zoom = False '是否缩放模式
  76.         .FitToPagesWide = 1
  77.         .FitToPagesTall = 200
  78.     End With
  79.     ActiveWindow.View = xlPageBreakPreview '打印模式窗口
  80.     ActiveWindow.Zoom = 100 '窗口缩放大小
  81.     Case Is < 1100
  82.     With ActiveSheet.PageSetup '初始设置
  83.         .LeftMargin = Application.InchesToPoints(0.393700787401575) '左边距
  84.         .RightMargin = Application.InchesToPoints(0.393700787401575) '右边距
  85.         .TopMargin = Application.InchesToPoints(0.393700787401575) '上边距
  86.         .BottomMargin = Application.InchesToPoints(0.393700787401575) '下边距
  87.         .HeaderMargin = Application.InchesToPoints(0.31496062992126) '页眉边距
  88.         .FooterMargin = Application.InchesToPoints(0.31496062992126) '页脚边距
  89.         .CenterHorizontally = True '水平居中
  90.         '.CenterVertically = False '垂直居中
  91.         '.Orientation = xlPortrait '页面纵向
  92.         .Orientation = xlLandscape '页面横向
  93.         .Draft = False
  94.         .PaperSize = xlPaperA4 'A4纸
  95.         .BlackAndWhite = False '是否黑白打印
  96.         .Zoom = False '是否缩放模式
  97.         .FitToPagesWide = 1
  98.         .FitToPagesTall = 200
  99.     End With
  100.     ActiveWindow.View = xlPageBreakPreview '打印模式窗口
  101.     ActiveWindow.Zoom = 100 '窗口缩放大小
  102.    
  103.     Case Is < 1400
  104.     With ActiveSheet.PageSetup '初始设置
  105.         .LeftMargin = Application.InchesToPoints(0.196850393700787) '左边距
  106.         .RightMargin = Application.InchesToPoints(0.196850393700787) '右边距
  107.         .TopMargin = Application.InchesToPoints(0.393700787401575) '上边距
  108.         .BottomMargin = Application.InchesToPoints(0.393700787401575) '下边距
  109.         .HeaderMargin = Application.InchesToPoints(0.31496062992126) '页眉边距
  110.         .FooterMargin = Application.InchesToPoints(0.31496062992126) '页脚边距
  111.         .CenterHorizontally = True '水平居中
  112.         '.CenterVertically = False '垂直居中
  113.         '.Orientation = xlPortrait '页面纵向
  114.         .Orientation = xlLandscape '页面横向
  115.         .Draft = False
  116.         .PaperSize = xlPaperA4 'A4纸
  117.         .BlackAndWhite = False '是否黑白打印
  118.         .Zoom = False '是否缩放模式
  119.         .FitToPagesWide = 1
  120.         .FitToPagesTall = 200
  121.     End With
  122.     ActiveWindow.View = xlPageBreakPreview '打印模式窗口
  123.     ActiveWindow.Zoom = 100 '窗口缩放大小
  124.     Case Is >= 1400
  125.     MsgBox "页面太大，超出自动设置范围！"

  127. End Select
  128.   

  130. Else '以下整个工作薄批量设置

  132. ii = Worksheets.Count
  133. For i = 1 To ii
  134. Dy = Worksheets(i).UsedRange.Count
  135. If Dy > 3 Then
  136. Din = Worksheets(i).UsedRange.Address
  137. Worksheets(i).PageSetup.PrintArea = Din 'ActiveSheet设置自动打印有数据的范围
  138. Worksheets(i).Activate
  139. 'Worksheets(i).Range("A4:A1000").SpecialCells(xlCellTypeVisible).EntireRow.AutoFit '设置自动行高Rows(A1000).End(xlUp)
  140. Col = Range(Din).EntireColumn.Width 'Width：返回的是以磅为单位的值


  143. Select Case Col
  144.     Case Is < 600
  145.     With Worksheets(i).PageSetup '初始设置
  146.         .LeftMargin = Application.InchesToPoints(0.708661417322835) '左边距
  147.         .RightMargin = Application.InchesToPoints(0.708661417322835) '右边距
  148.         .TopMargin = Application.InchesToPoints(0.590551181102362) '上边距
  149.         .BottomMargin = Application.InchesToPoints(0.590551181102362) '下边距
  150.         .HeaderMargin = Application.InchesToPoints(0.31496062992126) '页眉边距
  151.         .FooterMargin = Application.InchesToPoints(0.31496062992126) '页脚边距
  152.         .CenterHorizontally = True '水平居中
  153.         '.CenterVertically = False '垂直居中
  154.         .Orientation = xlPortrait '页面纵向
  155.         '.Orientation = xlLandscape '页面横向
  156.         .Draft = False
  157.         .PaperSize = xlPaperA4 'A4纸
  158.         .BlackAndWhite = False '是否黑白打印
  159.         .Zoom = False '是否缩放模式
  160.         .FitToPagesWide = 1
  161.         .FitToPagesTall = 200
  162.     End With
  163.     ActiveWindow.View = xlPageBreakPreview '打印模式窗口
  164.     ActiveWindow.Zoom = 100 '窗口缩放大小
  165.    
  166.     Case Is < 735
  167.     With Worksheets(i).PageSetup '初始设置
  168.         .LeftMargin = Application.InchesToPoints(0.393700787401575) '左边距
  169.         .RightMargin = Application.InchesToPoints(0.393700787401575) '右边距
  170.         .TopMargin = Application.InchesToPoints(0.393700787401575) '上边距
  171.         .BottomMargin = Application.InchesToPoints(0.393700787401575) '下边距
  172.         .HeaderMargin = Application.InchesToPoints(0.31496062992126) '页眉边距
  173.         .FooterMargin = Application.InchesToPoints(0.31496062992126) '页脚边距
  174.         .CenterHorizontally = True '水平居中
  175.         '.CenterVertically = False '垂直居中
  176.         .Orientation = xlPortrait '页面纵向
  177.         '.Orientation = xlLandscape '页面横向
  178.         .Draft = False
  179.         .PaperSize = xlPaperA4 'A4纸
  180.         .BlackAndWhite = False '是否黑白打印
  181.         .Zoom = False '是否缩放模式
  182.         .FitToPagesWide = 1
  183.         .FitToPagesTall = 200
  184.     End With
  185.     ActiveWindow.View = xlPageBreakPreview '打印模式窗口
  186.     ActiveWindow.Zoom = 100 '窗口缩放大小
  187.    
  188.          Case Is < 900
  189.     With Worksheets(i).PageSetup '初始设置
  190.         .LeftMargin = Application.InchesToPoints(0.708661417322835) '左边距
  191.         .RightMargin = Application.InchesToPoints(0.708661417322835) '右边距
  192.         .TopMargin = Application.InchesToPoints(0.393700787401575) '上边距
  193.         .BottomMargin = Application.InchesToPoints(0.393700787401575) '下边距
  194.         .HeaderMargin = Application.InchesToPoints(0.31496062992126) '页眉边距
  195.         .FooterMargin = Application.InchesToPoints(0.31496062992126) '页脚边距
  196.         .CenterHorizontally = True '水平居中
  197.         '.CenterVertically = False '垂直居中
  198.         '.Orientation = xlPortrait '页面纵向
  199.         .Orientation = xlLandscape '页面横向
  200.         .Draft = False
  201.         .PaperSize = xlPaperA4 'A4纸
  202.         .BlackAndWhite = False '是否黑白打印
  203.         .Zoom = False '是否缩放模式
  204.         .FitToPagesWide = 1
  205.         .FitToPagesTall = 200
  206.     End With
  207.     ActiveWindow.View = xlPageBreakPreview '打印模式窗口
  208.     ActiveWindow.Zoom = 100 '窗口缩放大小

  210.     Case Is < 1100
  211.     With Worksheets(i).PageSetup '初始设置
  212.         .LeftMargin = Application.InchesToPoints(0.393700787401575) '左边距
  213.         .RightMargin = Application.InchesToPoints(0.393700787401575) '右边距
  214.         .TopMargin = Application.InchesToPoints(0.393700787401575) '上边距
  215.         .BottomMargin = Application.InchesToPoints(0.393700787401575) '下边距
  216.         .HeaderMargin = Application.InchesToPoints(0.31496062992126) '页眉边距
  217.         .FooterMargin = Application.InchesToPoints(0.31496062992126) '页脚边距
  218.         .CenterHorizontally = True '水平居中
  219.         '.CenterVertically = False '垂直居中
  220.         '.Orientation = xlPortrait '页面纵向
  221.         .Orientation = xlLandscape '页面横向
  222.         .Draft = False
  223.         .PaperSize = xlPaperA4 'A4纸
  224.         .BlackAndWhite = False '是否黑白打印
  225.         .Zoom = False '是否缩放模式
  226.         .FitToPagesWide = 1
  227.         .FitToPagesTall = 200
  228.     End With
  229.     ActiveWindow.View = xlPageBreakPreview '打印模式窗口
  230.     ActiveWindow.Zoom = 100 '窗口缩放大小
  231.     Case Is < 1400
  232.     With Worksheets(i).PageSetup '初始设置
  233.         .LeftMargin = Application.InchesToPoints(0.196850393700787) '左边距
  234.         .RightMargin = Application.InchesToPoints(0.196850393700787) '右边距
  235.         .TopMargin = Application.InchesToPoints(0.393700787401575) '上边距
  236.         .BottomMargin = Application.InchesToPoints(0.393700787401575) '下边距
  237.         .HeaderMargin = Application.InchesToPoints(0.31496062992126) '页眉边距
  238.         .FooterMargin = Application.InchesToPoints(0.31496062992126) '页脚边距
  239.         .CenterHorizontally = True '水平居中
  240.         '.CenterVertically = False '垂直居中
  241.         '.Orientation = xlPortrait '页面纵向
  242.         .Orientation = xlLandscape '页面横向
  243.         .Draft = False
  244.         .PaperSize = xlPaperA4 'A4纸
  245.         .BlackAndWhite = False '是否黑白打印
  246.         .Zoom = False '是否缩放模式
  247.         .FitToPagesWide = 1
  248.         .FitToPagesTall = 200
  249.     End With
  250.     ActiveWindow.View = xlPageBreakPreview '打印模式窗口
  251.     ActiveWindow.Zoom = 100 '窗口缩放大小
  252.     Case Is >= 1400
  253.     MsgBox "页面太大，超出自动设置范围！"

  255. End Select
  256. End If
  257. Next i
  258. End If
  259. Application.ScreenUpdating = True '开启屏幕刷新
  260. End Sub
复制代码
回复

举报

fzh2618182

TA的精华主题

TA的得分主题
发表于 2013-1-14 10:11 | 显示全部楼层
[广告] ★ ChatOffice，能听会写的AI办公，包含百种Excel、Word、PPT工具，兼容WPS，百倍效率！★
可惜2003版不能用。
回复

举报

goldowl2011

TA的精华主题

TA的得分主题
发表于 2013-1-14 21:19 | 显示全部楼层
[广告] ★会Excel,就能做支持PC、手机、Web、App、Windows、安卓、IOS、Linux信息一体化的各种管理系统 ★
Mark .Thanks a lot.
回复

举报

xuyeshun1226

TA的精华主题

TA的得分主题
发表于 2013-1-17 13:05 | 显示全部楼层
[广告] ★用Excel做企业管理系统，Excel服务器学习和下载★
要是能添加 设置可以修改纸张类型就好了~~~~
回复

举报

atday

TA的精华主题

TA的得分主题
 楼主| 发表于 2013-1-26 22:55 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助★
xuyeshun1226 发表于 2013-1-17 13:05
要是能添加 设置可以修改纸张类型就好了~~~~

不是有吗？
回复

举报

tzy

TA的精华主题

TA的得分主题
发表于 2013-3-24 10:46 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册★
些分享，这个不错
回复

举报

zlith

TA的精华主题

TA的得分主题
发表于 2013-3-19 12:43 | 显示全部楼层
[广告] ★用Excel做企业管理系统，Excel服务器学习和下载★
谢谢分享！！
回复

举报

huangyun

TA的精华主题

TA的得分主题
发表于 2013-8-1 21:30 | 显示全部楼层
[广告] ★用Excel做企业管理系统，Excel服务器学习和下载★
学习 受用
回复

举报

cj198466

TA的精华主题

TA的得分主题
发表于 2013-10-17 14:50 | 显示全部楼层
[广告] ★Excel Home云课堂 - 专业的职场技能充电站★         ★Excel三大利器★        ★ 笨办法学VBA全系列★
找了好久终于找到了，楼主好强大，谢谢分享
回复

举报

下一页 »
12下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-5-2 07:42 , Processed in 0.041789 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！     本站特聘法律顾问：李志群律师

快速回复 返回顶部 返回列表