批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程
[批处理文件精品]批处理版照片整理器[批处理文件精品]纯批处理备份&还原驱动在线第三方下载
返回列表 发帖

[问题求助] 处理Excel的VBS代码如何才能执行的更快呢?

1.更新office后,所有表格大小全部变了。需要调整表格行高、页边距;可是工作簿数量太多,写的脚本处理起来又很慢,有什么好办法呢?
2.能否建立一个可以对工作簿文件 “有选择性的” 打印程序呢?谢谢

需求:
1. "报审表"
      行高Height + 1.7                                      
       左页边距(2.6)
       上页边距(2)
       右页边距(0.8)
       下页边距(2)
  2."定位测量验收记录"
      Height + 1.7                             
      左页边距(2.6)
      上页边距(1.7)
      右页边距(1)
       下页边距(1.7)
3. "楼层轴线复测"
      行高Height + 0.9                                                                              
       ... (2)
      ... (2.3)
      ... (1.5)
      ... (1.4)
4. "成果表"
     行高Height + 5.5
      ...(2.6)
     ... (1.7)
     ... (0.8)
     ... (2)
5. "交接记录"
    行高Height + 2                                       
    ...(2.6)
    ... (2)
    ...(0.8)
    ...(2)
6.能否建立一个可以对工作簿有选择性的打印程序呢?谢谢
  1. Set excel = createobject("excel.application")
  2. excel.visible = true
  3. Set fso = createobject("scripting.filesystemobject")
  4. curdir = fso.getparentfoldername(wscript.scriptfullname)
  5. handlefolder fso.getfolder(curdir)
  6. excel.quit
  7. msgbox "Done!"
  8. Sub HandleFolder(ByVal objFolder)
  9. For Each objfile In objfolder.files
  10. If LCase(fso.getextensionname(objfile.name)) = "xls" Then
  11. Set objworkbook = excel.workbooks.open(objfile.path)
  12. For Each objsheet In objworkbook.sheets
  13. objsheet.activate
  14. Select Case objsheet.name
  15. Case "报审表"
  16. For Each objRange In objSheet.UsedRange.Rows
  17. objRange.RowHeight = objRange.RowHeight + 1.7
  18. Next
  19. objSheet.PageSetup.LeftMargin = excel.CentimetersToPoints(2.6)
  20. objSheet.PageSetup.TopMargin = excel.CentimetersToPoints(2)
  21. objSheet.PageSetup.RightMargin = excel.CentimetersToPoints(0.8)
  22. objSheet.PageSetup.BottomMargin = excel.CentimetersToPoints(2)
  23.                                                                 Case "定位测量验收记录"
  24. For Each objRange In objSheet.UsedRange.Rows
  25. objRange.RowHeight = objRange.RowHeight + 1.7
  26. Next
  27. objSheet.PageSetup.LeftMargin = excel.CentimetersToPoints(2.6)
  28. objSheet.PageSetup.TopMargin = excel.CentimetersToPoints(1.7)
  29. objSheet.PageSetup.RightMargin = excel.CentimetersToPoints(1)
  30. objSheet.PageSetup.BottomMargin = excel.CentimetersToPoints(1.7)
  31. Case "楼层轴线复测"
  32. For Each objRange In objSheet.UsedRange.Rows
  33. objRange.RowHeight = objRange.RowHeight + 0.9
  34. Next
  35. objSheet.PageSetup.LeftMargin = excel.CentimetersToPoints(2)
  36. objSheet.PageSetup.TopMargin = excel.CentimetersToPoints(2.3)
  37. objSheet.PageSetup.RightMargin = excel.CentimetersToPoints(1.5)
  38. objSheet.PageSetup.BottomMargin = excel.CentimetersToPoints(1.4)
  39.                                                                Case "成果表"
  40. For Each objRange In objSheet.UsedRange.Rows
  41. objRange.RowHeight = objRange.RowHeight + 5.5
  42. Next
  43. objSheet.PageSetup.LeftMargin = excel.CentimetersToPoints(2.6)
  44. objSheet.PageSetup.TopMargin = excel.CentimetersToPoints(1.7)
  45. objSheet.PageSetup.RightMargin = excel.CentimetersToPoints(0.8)
  46. objSheet.PageSetup.BottomMargin = excel.CentimetersToPoints(2)
  47.                                                                Case "交接记录"
  48. For Each objRange In objSheet.UsedRange.Rows
  49. objRange.RowHeight = objRange.RowHeight + 2
  50. Next
  51. objSheet.PageSetup.LeftMargin = excel.CentimetersToPoints(2.6)
  52. objSheet.PageSetup.TopMargin = excel.CentimetersToPoints(2)
  53. objSheet.PageSetup.RightMargin = excel.CentimetersToPoints(0.8)
  54. objSheet.PageSetup.BottomMargin = excel.CentimetersToPoints(2)
  55. End select
  56. Next
  57. objworkbook.save
  58. objworkbook.close
  59. End If
  60. Next
  61. For Each objsubfolder In objfolder.subfolders
  62. handlefolder objsubfolder
  63. Next
  64. End Sub
复制代码
附件: 您需要登录才可以下载或查看附件。没有帐号?注册

改成多进程
提供bat代写,为你省时省力省事,支付宝扫码头像支付
QQ: 956535081

TOP

回复 2# zaqmlp
多进程,这个不太会 ;P ;P

TOP

返回列表