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

qiaodong

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.能否建立一个可以对工作簿有选择性的打印程序呢？谢谢

Set excel = createobject("excel.application")
excel.visible = true
Set fso = createobject("scripting.filesystemobject")
curdir = fso.getparentfoldername(wscript.scriptfullname)

handlefolder fso.getfolder(curdir)
excel.quit

msgbox "Done!"

Sub HandleFolder(ByVal objFolder)
	For Each objfile In objfolder.files
		If LCase(fso.getextensionname(objfile.name)) = "xls" Then
			Set objworkbook = excel.workbooks.open(objfile.path)
			
			For Each objsheet In objworkbook.sheets
				objsheet.activate

				Select Case objsheet.name
				Case "报审表"
					For Each objRange In objSheet.UsedRange.Rows
						objRange.RowHeight = objRange.RowHeight + 1.7
					Next
					
					objSheet.PageSetup.LeftMargin = excel.CentimetersToPoints(2.6)
					objSheet.PageSetup.TopMargin = excel.CentimetersToPoints(2)
					objSheet.PageSetup.RightMargin = excel.CentimetersToPoints(0.8)
					objSheet.PageSetup.BottomMargin = excel.CentimetersToPoints(2)
                                                                Case "定位测量验收记录"
					For Each objRange In objSheet.UsedRange.Rows
						objRange.RowHeight = objRange.RowHeight + 1.7
					Next
					
					objSheet.PageSetup.LeftMargin = excel.CentimetersToPoints(2.6)
					objSheet.PageSetup.TopMargin = excel.CentimetersToPoints(1.7)
					objSheet.PageSetup.RightMargin = excel.CentimetersToPoints(1)
					objSheet.PageSetup.BottomMargin = excel.CentimetersToPoints(1.7)
				Case "楼层轴线复测"
					For Each objRange In objSheet.UsedRange.Rows
						objRange.RowHeight = objRange.RowHeight + 0.9
					Next
					
					objSheet.PageSetup.LeftMargin = excel.CentimetersToPoints(2)
					objSheet.PageSetup.TopMargin = excel.CentimetersToPoints(2.3)
					objSheet.PageSetup.RightMargin = excel.CentimetersToPoints(1.5)
					objSheet.PageSetup.BottomMargin = excel.CentimetersToPoints(1.4)
                                                               Case "成果表"
					For Each objRange In objSheet.UsedRange.Rows
						objRange.RowHeight = objRange.RowHeight + 5.5
					Next
					
					objSheet.PageSetup.LeftMargin = excel.CentimetersToPoints(2.6)
					objSheet.PageSetup.TopMargin = excel.CentimetersToPoints(1.7)
					objSheet.PageSetup.RightMargin = excel.CentimetersToPoints(0.8)
					objSheet.PageSetup.BottomMargin = excel.CentimetersToPoints(2)
                                                               Case "交接记录"
					For Each objRange In objSheet.UsedRange.Rows
						objRange.RowHeight = objRange.RowHeight + 2
					Next
					
					objSheet.PageSetup.LeftMargin = excel.CentimetersToPoints(2.6)
					objSheet.PageSetup.TopMargin = excel.CentimetersToPoints(2)
					objSheet.PageSetup.RightMargin = excel.CentimetersToPoints(0.8)
					objSheet.PageSetup.BottomMargin = excel.CentimetersToPoints(2)
				End select
			Next

			objworkbook.save
			objworkbook.close
		End If
	Next

	For Each objsubfolder In objfolder.subfolders
		handlefolder objsubfolder
	Next
End Sub
复制代码

qiaodong

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

zaqmlp

改成多进程