Здравствуйте.
Подскажите пожалуйста, как упростить ниже приведенный макрос, который делает это:
открывает файл, изменяет ширину столбца "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