修改文件夹内字体的代码，不知道哪儿错了。。。。

yoorel

很简单的一个修改字体的，循环不了，打开不了文件。。。。

limonet

压缩包是这样子的，文件是那样子的。

yoorel

limonet 发表于 2024-6-20 18:40
压缩包是这样子的，文件是那样子的。

不好意思重新发附件

yoorel

重新发附件

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.6.20
   
2.     Set fso = CreateObject("scripting.filesystemobject")
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     p = ThisWorkbook.Path & ""
   
6.     For Each f In fso.GetFolder(p).Files
   
7.         If InStr(f.Name, ThisWorkbook.Name) = 0 Then
   
8.             fn = fso.GetBaseName(f)
   
9.             Set wb = Workbooks.Open(f, 0)
   
10.             For Each sht In wb.Sheets
    
11.                 With sht.Columns("V").Font
    
12.                     .Size = 12  ' 设置字体大小为12
    
13.                 End With
    
14.             Next
    
15.             wb.Close 1
    
16.         End If
    
17.     Next f
    
18.     Application.ScreenUpdating = True
    
19.     MsgBox "OK！"
    
20. End Sub
    
21. 
    

复制代码

gwjkkkkk

...............

quqiyuan

参与一下。。。

quqiyuan

代码如下。。。
Sub ChangeFontInColumnV()
    Dim ws As Worksheet
    Dim wb As Workbook
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String

    ' 关闭警告消息
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    ' 设置当前文件夹路径
    myPath = ThisWorkbook.Path & "\"
    myExtension = "*.xls*"

    ' 获取当前路径下的第一个Excel文件
    myFile = Dir(myPath)

    ' 遍历所有文件
    Do While myFile <> ""
        ' 打开文件
        If myFile <> ThisWorkbook.Name Then
            If LCase(myFile) Like myExtension Then
                Set wb = Workbooks.Open(Filename:=myPath & "\" & myFile)
               
                ' 遍历所有工作表
                For Each ws In wb.Sheets
                    With ws.Columns("V").Font
                        .Size = 12  ' 设置字体大小为12
                    End With
                Next ws
        
                ' 保存并关闭工作簿
                wb.Close SaveChanges:=True
            End If
        End If
        ' 获取下一个文件
        myFile = Dir
    Loop

    ' 恢复警告消息
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    MsgBox "所有文件处理完成!"
End Sub

yoorel

quqiyuan 发表于 2024-6-20 20:42
代码如下。。。
Sub ChangeFontInColumnV()
    Dim ws As Worksheet

感谢  明白捞