Последовательное открывание файлов excel для внесения изменений

Автор Илья, 23 января 2015, 13:06

Илья

Здравствуйте.
Подскажите пожалуйста, как упростить ниже приведенный макрос, который делает это:
открывает файл, изменяет ширину столбца "S", сохраняет и закрывает файл, затем следующий файл...
И таких может быть более 20 шт. Все изменяемые файлы находятся в одной папке.

Спойлер
Sub Макрос1()
   
    Workbooks.Open Filename:="C:\Иванов.xls"
    Sheets("Лист1").Select
    ActiveSheet.Unprotect
    Columns("S:S").ColumnWidth = 7.14
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Workbooks(ActiveWorkbook.Name).Close (True)
   
    Workbooks.Open Filename:="C:\Петров.xls"
    Sheets("Лист1").Select
    ActiveSheet.Unprotect
    Columns("S:S").ColumnWidth = 7.14
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Workbooks(ActiveWorkbook.Name).Close (True)
   
    Workbooks.Open Filename:="C:\Сидоров.xls"
    Sheets("Лист1").Select
    ActiveSheet.Unprotect
    Columns("S:S").ColumnWidth = 7.14
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Workbooks(ActiveWorkbook.Name).Close (True)
   
    Workbooks.Open Filename:="C:\Николаев.xls"
    Sheets("Лист1").Select
    ActiveSheet.Unprotect
    Columns("S:S").ColumnWidth = 7.14
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Workbooks(ActiveWorkbook.Name).Close (True)

End Sub
[свернуть]

Администратор

Код:
Sub Макрос1()

    ' Для удобства написания макроса подключите библиотеку: Tools - References... - Windows Script Host Object Model.
        ' После написания макроса можно будет отключить библиотеку, если она будет мешать.
    Dim myFSO As IWshRuntimeLibrary.FileSystemObject
    Dim myFolder As IWshRuntimeLibrary.Folder, myFile As IWshRuntimeLibrary.File
    Dim bk As Excel.Workbook, sh As Excel.Worksheet
   
    ' Создание и VBA-наименование объекта для работы с папками и файлами.
    Set myFSO = CreateObject(Class:="Scripting.FileSystemObject")
   
    ' VBA-наименование папки, в которой находятся файлы, которые надо изменить.
    ' Для диска нужно указывать слеш. Для обычной папки слеш не нужен, например: myFSO.GetFolder("C:\Папка")
    Set myFolder = myFSO.GetFolder("C:\")
   
    ' Просмотр всех файлов в папке.
    For Each myFile In myFolder.Files
        ' Открытие и VBA-наименование файла.
        Set bk = Workbooks.Open(myFile.Path)
        ' VBA-наименование активного листа.
        Set sh = bk.ActiveSheet
        ' Изменение листа.
        sh.Unprotect
        sh.Columns("S:S").ColumnWidth = 7.14
        sh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
        bk.Close True
    Next myFile

End Sub
[свернуть]