Dim obj_file As Object, objFSO As Object
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set objFSO = CreateObject("Scripting.FileSystemObject")
avFiles = Application.GetOpenFilename _
("Excel files(*.xl*),*.xl*", 2, "Выбрать Excel файлы", , True) ',Text files(*.txt),*.txt
If IsArray(avFiles) = False Then Exit Sub
int_File_Number = UBound(avFiles) 'количество выделенных файлов
For i = 1 To int_File_Number
Set obj_file = Workbooks.Open(avFiles(i))
'тут пишем, что делать с файлом
obj_file.Save
obj_file.Close
Next
Set objFSO = Nothing: Set obj_file = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sub Удалить_листы_кроме_первого()
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Sheets
If ws.Index <> 1 Then ws.Delete
Next: Application.DisplayAlerts = True
End Sub
‘Время выполнения процедуры (макроса, подпрограммы)
Dim iTimer As Single
iTimer = Timer
MsgBox "Время выполнения макроса: " & Format((Timer - iTimer) / 86400, "Long Time"), vbExclamation, ""
Sub Действия_в_одну_строку()
| 'Выравнивание колонки по ширине Columns(2).AutoFit |
'Задать ширину колонку Columns("B:E").ColumnWidth = 25 |
'Задаем высоту строк Rows("3:25").RowHeight = 25 |
'защитить лист
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="32123"
'добавляем гиперссылку в ячейку
ActiveSheet.Hyperlinks.Add Anchor:=Cells(1, 1), Address:="http://www.vbahelper.ucoz.site"
'удаляем (очищаем) содержимое ячейки, оставляем формат
Range("b7:r30").ClearContents
FileNameByPath = Dir(Path) 'получаем имя файл по полному пути (если файл отсутствует, то вылетит ошибка)
( Dir() перебирает все файлы в папке и ищет указанные, допустимы символы * и ? (для одного знака))
'снимаем выделение для копирования (тогда точно не будет ошибок закрытия файла)
Application.CutCopyMode = False
'указываем, что книга сохранена, хотя это может быть и не так
ActiveWorkbook.Saved = True
'копируем формулы в точности (не будет подтягиваться ссылка на другую книгу)
Range("n6:r30") = Range("n6:r30").Formula
'смотрим количество текущих открытых писем в outlook
objOutlookApp.inspectors.Count
'открыть папку указанную или exe file
Call Shell("explorer.exe C:\", vbNormalFocus)
Call Shell("explorer.exe " & Выбранная_папка, vbNormalFocus)
' закрепляем первую строку листа
[a2].Activate: ActiveWindow.FreezePanes = True
'открыть редактор кода на указанном макросе
Application.Goto "Модуль1.Макрос1"
' или так переходим к нужному макросу
ThisWorkbook.FollowHyperlink "#RankModule1.Just1"
'закрываем надстройку
Workbooks("Книга1.xlam").Close SaveChanges:=True
'отключаем (закрываем) статус бар
Application.DisplayStatusBar = True
'ищем (поиск) в столбце совпадение
IsMatch = IsError(Application.Match("Apples", ActiveSheet.Columns(5), 0))
If IsMatch = False Then Match_Row = Application.Match("Apples", ActiveSheet.Columns(5), 0)
'Блокируем ячейку для фильтрации в сводной таблице
ActiveSheet.PivotTables(1).PivotFields(BlockCell).EnableItemSelection = False
ActiveWorkbook.Saved = False 'т.к. этот запрет не считается за изменение
ActiveWorkbook.Close True
End Sub
'Создаем текстовый файл.
Set fso = createobject("Scripting.FileSystemObject")
Dim oFile as object
Set oFile = fso.createTextFile("D:\text.txt")
oFile.WriteLine "test"
oFile.Close : Set fso = nothing, set oFile = nothing