Однотипное форматирование нескольких документов

[tibhar940]

Написал макрос изменения форматирования документа.
Но он действует только на открытую книгу.
Подскажите, как сделать, чтобы можно было применить данный макрос к нескольким файлам? Устроит любой вариант (применение к файлам в определённой папке, или же выбор файлов...)

[kuklp]

Сообщение от tibhar940

Написал макрос изменения форматирования документа...

Но вам его не покажу!:-)

Сообщение от tibhar940

Но он действует только на открытую книгу.

Дык, оне все практически. Не ну кроме kill там, oldname as newname и т.д.

Сообщение от tibhar940

Подскажите, как сделать, чтобы можно было применить данный макрос к нескольким файлам? Устроит любой вариант...

Копируйте его в несколько файлов и применяйте.
?

[tibhar940]

Сообщение от kuklp

Но вам его не покажу!:-)

Дык, оне все практически. Не ну кроме kill там, oldname as newname и т.д.
Копируйте его в несколько файлов и применяйте.
?

Sub Форматирование()

'1)изменение колонтитула на КОЛОНТИТУЛ
With ActiveSheet.PageSetup
.RightHeader = " &""Arial,полужирный"" КОЛОНТИТУЛ"
End With

'2)переименование листа
ActiveSheet.Name = "ЛИСТ"

'3)подстановка нужной шапки с переменными
Range("A1") = "Слова A с B "

'4)удаление лишних данных в ячейке
Range("A3") = " "

'5)замена за период на в течение периода
Range("A2").Select
ActiveCell.Replace What:="за период", Replacement:="в течение периода", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False

'6)удаление ненужных столбцов и снятие выделения со столбца
Columns("D:D").Delete
Columns("O:O").Delete
Columns("Q:Q").Select
Selection.Interior.ColorIndex = xlNone

'7)Выбор человека через инпутбокс
Dim uch As Variant
uch = InputBox("выберите человека", "ЧЕЛОВЕК", "")

If uch <> "" Then
Range("A1").Select
ActiveCell.Replace What:="A", Replacement:=uch, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
End If

'8)Выбор штуки через инпутбокс
Dim ins As Variant
ins = InputBox("Выберите штуку", "ШТУКА", "")

If ins <> "" Then
Range("A1").Select
ActiveCell.Replace What:="B", Replacement:=ins, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
End If

End Sub


Ну вот макрос. Мне сотню файлов как-то не шибко удобно открывать и в каждой применять макрос. Поэтому захотел посоветоваться. в идеале хочу чтобы можно было кинуть файлики в папочку, запустить макрос, и он их преобразует в нужное форматирование.

[kuklp]

Почитайте справку по GetOpenFilename Method
Там и пример есть. И в поиске много интересного мона найти.

[DiemonStar]

используйте объекты из "Scripting.FileSystemObject" для перебора файлов в каталоге и по-очереди их открывайте, а потом форматируйте.
http://programmersforum.ru/showthread.php?t=30219
В этой теме немало примеров, как сделать подобное.

[tibhar940]

Сообщение от DiemonStar

используйте объекты из "Scripting.FileSystemObject" для перебора файлов в каталоге и по-очереди их открывайте, а потом форматируйте.
http://programmersforum.ru/showthread.php?t=30219
В этой теме немало примеров, как сделать подобное.

Спасибо. Направьте меня в нужное русло пожалуйста)
Вот моя программа действия. Я выбираю папку, открываю файлы, применяю нужное форматирование. Так?

Пока что у меня получилось примерно так:

Sub PaketnayaObrabotka()

On Error Resume Next
Set Fso = CreateObject("Scripting.FileSystemO bject")
Set folder = Fso.GetFolder("C:\Documents and Settings\1")
MsgBox folder.Name
For Each file In folder.Files
Range("A1") = "Ячейка"
Next

End Sub

Но при запуске макроса не изменяет файлы. А если их открыть и запустить макрос, то изменяет лишь один из файлов. Видимо активный.

Направьте начинающего в нужное русло)
Спасибо.

[tibhar940]

Сообщение от tibhar940

Спасибо. Направьте меня в нужное русло пожалуйста)
Вот моя программа действия. Я выбираю папку, открываю файлы, применяю нужное форматирование. Так?

Пока что у меня получилось примерно так:

Sub PaketnayaObrabotka()

On Error Resume Next
Set Fso = CreateObject("Scripting.FileSystemO bject")
Set folder = Fso.GetFolder("C:\Documents and Settings\1")
MsgBox folder.Name
For Each file In folder.Files
Range("A1") = "Ячейка"
Next

End Sub

Но при запуске макроса не изменяет файлы. А если их открыть и запустить макрос, то изменяет лишь один из файлов. Видимо активный.

Направьте начинающего в нужное русло)
Спасибо.

Господа, подскажите всё-таки. ЧЯДНТ?) Вроде бы должно ведь работать.

[kuklp]

Sub PaketnayaObrabotka()

'On Error Resume Next
Set Fso = CreateObject("Scripting.FileSystemObject")
Set folder = Fso.GetFolder("C:\Documents and Settings\1")
MsgBox folder.Name
For Each file In folder.Files
With Workbooks.Open(file.Path).Worksheets(1).[a1]
.Value = "Ячейка"
.Parent.Parent.Close -1
End With
Next

End Sub

[tibhar940]

Сообщение от kuklp

Sub PaketnayaObrabotka()

'On Error Resume Next
Set Fso = CreateObject("Scripting.FileSystemObject")
Set folder = Fso.GetFolder("C:\Documents and Settings\1")
MsgBox folder.Name
For Each file In folder.Files
With Workbooks.Open(file.Path).Worksheets(1).[a1]
.Value = "Ячейка"
.Parent.Parent.Close -1
End With
Next

End Sub

Спасибо большое! Пытался сначала сам вставить With, но у меня ругалось всё время. Такой вариант я даже не пробовал.

Еще 2 вопроса:
Как называются эти команды после точки (обобщающее значение)? где можно почитать?
Как вставлять в тело сообщения на форуме код с подсветкой?

И еще маленький вопросик:
With Workbooks.Open(file.Path).Worksheet s(1).[a1]
.Value = "Ячейка"
.Parent.Parent.Close -1
End With

Допустим я хочу изменить еще ряд параметров страницы и не обязательно с ячейкой А1, но если я выделю это в отдеьный виф, то это будет замедлять макрос, поскольку снова откроет файлы, скорректирует их и закроет. Как можно этого избежать? Может в теле Виф можно какой-нибудь оператор использовать со смыслом "и" ?
Заранее извиняюсь за мою неполную компетентность в терминологии)
___________________________________ _________________________
Sub PaketnayaObrabotka()

'On Error Resume Next
Set Fso = CreateObject("Scripting.FileSystemO bject")
Set folder = Fso.GetFolder("C:\Documents and Settings\1")
MsgBox folder.Name
For Each File In folder.Files

With Workbooks.Open(File.Path).Worksheet s(1).[a1]
.Value = "Слова слова слова"
.Parent.Parent.Close -1
End With

With Workbooks.Open(File.Path).Worksheet s(1).[a3]
.Value = " "
.Parent.Parent.Close -1
End With

With Workbooks.Open(File.Path).Worksheet s(1).PageSetup
.RightHeader = " &""Arial,полужирный""Колонтитул"
ActiveSheet.Name = "Лейбл"
.Parent.Parent.Close -1
End With
Next

End Sub

Вот на этом примере можно это упростить? Чтобы каждый раз не закрывалось - открывалось?

[kuklp]

Sub PaketnayaObrabotka()
'On Error Resume Next
Set Fso = CreateObject("Scripting.FileSystemO bject")
Set folder = Fso.GetFolder("C:\Documents and Settings\1")
MsgBox folder.Name
For Each File In folder.Files
With Workbooks.Open(File.Path).Worksheets(1)
.[a1].Value = "Слова слова слова"
.[a3].Value = " "
with .PageSetup
.RightHeader = " &""Arial,полужирный""Колонтитул"
ActiveSheet.Name = "Лейбл" ' это не понял, мы работаем с Worksheets(1)
end with
.Parent.Parent.Close -1
End With
Next
End Sub

>> Как вставлять в тело сообщения на форуме код с подсветкой?
tibhar940, пожалуйста, пользуйтесь тегами оформления кода. Это знак диез(решетка) над окном редактирования:-)
PS писал с коленки, не проверял.