如何将目录下所有工作簿的Sheet3表D列设置指定的列宽

hhak003

求助各位大大   如何大批量的将目录下所有工作簿的Sheet3表D列  设置一个指定的列宽

lsc900707

1. Sub gj23w98a()
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     p = ThisWorkbook.Path
   
5.     f = Dir(p & "\*.xls*")
   
6.     Do While Len(f)
   
7.         If f <> ActiveWorkbook.Name Then
   
8.             Set wb = Workbooks.Open(p & "" & f)
   
9.             wb.Sheets(3).Columns(4).ColumnWidth = 40
   
10.             wb.Close True
    
11.         End If
    
12.         f = Dir
    
13.     Loop
    
14.     Application.ScreenUpdating = True
    
15.     Application.DisplayAlerts = True
    
16.     MsgBox "批量修改完成！"
    
17. End Sub

复制代码

建议楼主上传附件看看。

yylucke

Private Sub CommandButton1_Click()
    Dim MyPath$, MyFile$, MyD, AK As Workbook
    Application.ScreenUpdating = False '冻结屏幕，以防屏幕抖动
    Application.DisplayAlerts = False
    MyPath = ThisWorkbook.Path '把文件路径定义给变量
    MyD = Sheet1.Columns(4).ColumnWidth

    MyFile = Dir(MyPath & "\*.xls*") '依次找寻指定路径中的eXCEL文件
    Do While MyFile <> ""
        If MyFile <> ThisWorkbook.Name Then
            Set AK = Workbooks.Open(MyPath & "\" & MyFile)
            For Each sh In AK.Worksheets
                If sh.Name = "Sheet3" Then sh.Columns(4).ColumnWidth = MyD
            Next
            AK.Close Savechanges:=True
        End If
        MyFile = Dir
    Loop
    Application.ScreenUpdating = True '冻结屏幕,此类语句一般成对使用
    Application.DisplayAlerts = True
End Sub

yylucke

请参考附件

hhak003

yylucke 发表于 2018-6-21 14:33
请参考附件

谢谢大神，完美解决了我的问题~~好赞~