批处理之家's Archiver

qiaodong 发表于 2019-4-19 15:59

处理Excel的VBS代码如何才能执行的更快呢?

[size=6][u][b]1.更新office后,所有表格大小全部变了。需要调整表格行高、页边距;可是工作簿数量太多,写的脚本处理起来又很慢,有什么好办法呢?
2.能否建立一个可以对工作簿文件 “有选择性的” 打印程序呢?谢谢[/b][/u][/size]
[font=黑体][b]需求:
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.能否建立一个可以对工作簿有选择性的打印程序呢?谢谢
[/b][/font][code]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
[/code]

zaqmlp 发表于 2019-4-19 16:45

改成多进程

qiaodong 发表于 2019-4-19 16:50

[b]回复 [url=http://www.bathome.net/redirect.php?goto=findpost&pid=219483&ptid=52608]2#[/url] [i]zaqmlp[/i] [/b]
多进程,这个不太会;P ;P ;P

页: [1]

Powered by Discuz! Archiver 7.2  © 2001-2009 Comsenz Inc.