VB能否更快的调整表格行高、页边距吗？

qiaoqiao123

更新office后，所有表格大小全部变了。需要调整表格行高、页边距；可是工作簿数量太多，写的脚本处理起来又很慢，有什么好办法呢？

需求：

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)

代码：

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(file:///C:\Users\LZQ\AppData\Local\Temp\%W@GJ$ACOF(TYDYECOKVDYB.pngobjfile.name)) = "xls" Then
                        Set objworkbook = excel.workbooks.open(objfile.path)
                        
                        For Each objsheet In objworkbook.sheets
                                objsheet.activate

                                Select Case file:///C:\Users\LZQ\AppData\Local\Temp\%W@GJ$ACOF(TYDYECOKVDYB.pngobjsheet.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

qiaoqiao123

这个脚本执行的很慢，有没有什么好办法
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(file:///C:\Users\LZQ\AppData\Local\Temp\%W@GJ$ACOF(TYDYECOKVDYB.pngobjfile.name)) = "xls" Then
                        Set objworkbook = excel.workbooks.open(objfile.path)
                       
                        For Each objsheet In objworkbook.sheets
                                objsheet.activate

                                Select Case file:///C:\Users\LZQ\AppData\Local\Temp\%W@GJ$ACOF(TYDYECOKVDYB.pngobjsheet.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

砂海

来自: [入门] 加快你的代码运行速度

3)大家可能经常看到的在Sub开始的两条语句可以大大加快代码速度:

Application.ScreenUpdating = FALSE   '禁止屏幕刷新
Application.Calculation = xlCalculationManual   '计算模式为手动

一般在Sub结束前改回:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = TRUE

9)当对某一目标进行多次操作时,尽量用With...End With,如:
With Worksheets("Sheet1").Range("A1")
    .Font.Bold = True
    .Value = 123
End With

qiaoqiao123

砂海 发表于 2019-4-19 15:18
来自: [入门] 加快你的代码运行速度

3)大家可能经常看到的在Sub开始的两条语句可以大大加快代码速度:

嗯是的，VB不太懂，脚本上我觉得慢的原因还是“单进程”处理