Board logo

标题: [问题求助] 处理Excel的VBS代码如何才能执行的更快呢？ [打印本页]
作者: qiaodong    时间: 2019-4-19 15:59     标题: 处理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. 

  6. handlefolder fso.getfolder(curdir)

  7. excel.quit

  8. 

  9. msgbox "Done!"

  10. 

  11. Sub HandleFolder(ByVal objFolder)

  12. 	For Each objfile In objfolder.files

  13. 		If LCase(fso.getextensionname(objfile.name)) = "xls" Then

  14. 			Set objworkbook = excel.workbooks.open(objfile.path)

  15. 			

  16. 			For Each objsheet In objworkbook.sheets

  17. 				objsheet.activate

  18. 

  19. 				Select Case objsheet.name

  20. 				Case "报审表"

  21. 					For Each objRange In objSheet.UsedRange.Rows

  22. 						objRange.RowHeight = objRange.RowHeight + 1.7

  23. 					Next

  24. 					

  25. 					objSheet.PageSetup.LeftMargin = excel.CentimetersToPoints(2.6)

  26. 					objSheet.PageSetup.TopMargin = excel.CentimetersToPoints(2)

  27. 					objSheet.PageSetup.RightMargin = excel.CentimetersToPoints(0.8)

  28. 					objSheet.PageSetup.BottomMargin = excel.CentimetersToPoints(2)

  29.                                                                 Case "定位测量验收记录"

  30. 					For Each objRange In objSheet.UsedRange.Rows

  31. 						objRange.RowHeight = objRange.RowHeight + 1.7

  32. 					Next

  33. 					

  34. 					objSheet.PageSetup.LeftMargin = excel.CentimetersToPoints(2.6)

  35. 					objSheet.PageSetup.TopMargin = excel.CentimetersToPoints(1.7)

  36. 					objSheet.PageSetup.RightMargin = excel.CentimetersToPoints(1)

  37. 					objSheet.PageSetup.BottomMargin = excel.CentimetersToPoints(1.7)

  38. 				Case "楼层轴线复测"

  39. 					For Each objRange In objSheet.UsedRange.Rows

  40. 						objRange.RowHeight = objRange.RowHeight + 0.9

  41. 					Next

  42. 					

  43. 					objSheet.PageSetup.LeftMargin = excel.CentimetersToPoints(2)

  44. 					objSheet.PageSetup.TopMargin = excel.CentimetersToPoints(2.3)

  45. 					objSheet.PageSetup.RightMargin = excel.CentimetersToPoints(1.5)

  46. 					objSheet.PageSetup.BottomMargin = excel.CentimetersToPoints(1.4)

  47.                                                                Case "成果表"

  48. 					For Each objRange In objSheet.UsedRange.Rows

  49. 						objRange.RowHeight = objRange.RowHeight + 5.5

  50. 					Next

  51. 					

  52. 					objSheet.PageSetup.LeftMargin = excel.CentimetersToPoints(2.6)

  53. 					objSheet.PageSetup.TopMargin = excel.CentimetersToPoints(1.7)

  54. 					objSheet.PageSetup.RightMargin = excel.CentimetersToPoints(0.8)

  55. 					objSheet.PageSetup.BottomMargin = excel.CentimetersToPoints(2)

  56.                                                                Case "交接记录"

  57. 					For Each objRange In objSheet.UsedRange.Rows

  58. 						objRange.RowHeight = objRange.RowHeight + 2

  59. 					Next

  60. 					

  61. 					objSheet.PageSetup.LeftMargin = excel.CentimetersToPoints(2.6)

  62. 					objSheet.PageSetup.TopMargin = excel.CentimetersToPoints(2)

  63. 					objSheet.PageSetup.RightMargin = excel.CentimetersToPoints(0.8)

  64. 					objSheet.PageSetup.BottomMargin = excel.CentimetersToPoints(2)

  65. 				End select

  66. 			Next

  67. 

  68. 			objworkbook.save

  69. 			objworkbook.close

  70. 		End If

  71. 	Next

  72. 

  73. 	For Each objsubfolder In objfolder.subfolders

  74. 		handlefolder objsubfolder

  75. 	Next

  76. End Sub
复制代码
作者: zaqmlp    时间: 2019-4-19 16:45

改成多进程
作者: qiaodong    时间: 2019-4-19 16:50

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



欢迎光临 批处理之家 (http://www.bathome.net/) Powered by Discuz! 7.2