Как обращаться к шаблону?

PlanB

для каждого файла в указанной папке вызываю ProsessXLS
Option Explicit
Sub eachFol()
Dim fso As FileSystemObject
'Путь к папке
Const sPath = "C:\testCoef"

Dim b As Workbook
Dim fol1 As Folder, fol As Folder
Dim f As File
Dim n As Integer

Set b = ActiveWorkbook
Set fso = New FileSystemObject
Set fol1 = fso.GetFolder(sPath)
 'Ходим по всем файлам в папке
 n = <b>3</b>
 For Each f In fol1.Files
' If Right(f.Name, 4) = ".xls" Or Right(f.Name, 4) = ".XLS" Then
 Application.ScreenUpdating = False
 
 Call ProsessXLS(f.Path, b, n)
 Application.ScreenUpdating = True
 n = n + <b>1</b>
' End If 'Right(f.Name, 4) = ".xls"
 Next f
End Sub
В нё требуется для каждого такого файла создать шаблон (он сохранён по пути: C:\Documents and Settings\***\Application Data\Microsoft\Шаблоны\Coefficient v3.1.xlt) и из старого файла копирнуть в новый некоторую инфу.Чё-та не очень получается. не могу обратиться ко вновь созданному шаблону. Подскажите, плиз, у меня ступор...рекордер говорит примерно следующее:
Application.Workbooks.Add Template:="C:\Documents and Settings\kutenko\Application Data\Microsoft\Шаблоны\Coefficient v3.1.xlt"
9 ответов

PlanB

> Автор: PlanBПривет.> рекордер говорит примерно следующее:Ну так и подхватывай, что тебе говорит рекодер :)
Dim wTempl As Workbook
Set wTempl = Application.Workbooks.Add (Template:="C:\Documents and Settings\kutenko\Application 
Data\Microsoft\Шаблоны\Coefficient v3.1.xlt")


PlanB

аа, на скобочки, походу, ругался Спасибо!


PlanB

точнее, на их отсутствие


PlanB

Когда я программно создаю шаблон, это происходит довольно долго (по ощущениям, ручками быстрее)...через F8 когда поргоняю, тупит перед открытием, пока все окна кода в редакторе VBA не развернёт (в шаблонах предостаточно макросов) С этим не поборишься?Спасибо!


PlanB

> Автор: PlanB> С этим не поборишься?Врядли, хотя имеет смысл выключать обновление окна и автоматический пересчет листов. Можно на время открытия делать екселю visible=false.


PlanB

ок, спасибо!


PlanB

Слов нет!Когда начинаю программно заносить данные в шаблон, в нём начинают без спроса выполняться макросы Worksheet_Change и Public функции. Это безобразие можно прекратить? А то я бешусь уже :)можно запрещать работу макросов в шаблоне при открытии? предполагаю, нет :)


PlanB

PlanB,application.enableevents


PlanB

Добавил, а функциям и событиям всё нипочём (что не так делаю?
Option Explicit
Sub eachFol()
Dim fso As FileSystemObject
'Путь к папке
Const sPath = "C:\testCoef"

Dim b As Workbook
Dim fol1 As Folder, fol As Folder
Dim f As File
Dim n As Integer

Set b = ActiveWorkbook
Set fso = New FileSystemObject
Set fol1 = fso.GetFolder(sPath)
 'Ходим по всем файлам в папке
 n = <b>0</b>
 For Each f In fol1.Files
' If Right(f.Name, 4) = ".xls" Or Right(f.Name, 4) = ".XLS" Then
 Application.ScreenUpdating = False
 Application.EnableEvents = True
 Call ProsessXLS(f.Path, b)
 Application.EnableEvents = False
 Application.ScreenUpdating = True
 n = n + <b>1</b>
 ThisWorkbook.Sheets(<b>1</b>).Cells(<b>1</b>, <b>1</b>) = n
' End If 'Right(f.Name, 4) = ".xls"
 Next f
End Sub

'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Sub ProsessXLS(fPath As String, b As Workbook)
Dim b1 As Workbook 'анализируемая книга
Dim b2 As Workbook 'новый файл шаблона
Dim nName As String
Application.Workbooks.Add Template:="C:\Documents and Settings\kutenko\Application Data\Microsoft\Шаблоны\Coefficient v3.1.xlt"

Set b2 = ActiveWorkbook ' шаблон
Set b1 = Application.Workbooks.Open(fPath, False) 'книга для анализа

nName = b2.Sheets("Заявка").Range("C3")


'в тупую копировать одну за другой строчку
b2.Sheets("Заявка").Range("C3") = b1.Sheets("Заявка").Range("C3")
b2.Sheets("Заявка").Range("C5") = b1.Sheets("Заявка").Range("C5")
b2.Sheets("Заявка").Range("C6") = b1.Sheets("Заявка").Range("C6")
b2.Sheets("Заявка").Range("C7") = b1.Sheets("Заявка").Range("C7")
b2.Sheets("Заявка").Range("C8") = b1.Sheets("Заявка").Range("C8")
b2.Sheets("Заявка").Range("C10") = b1.Sheets("Заявка").Range("C10")
b2.Sheets("Заявка").Range("C12") = b1.Sheets("Заявка").Range("C12")
b2.Sheets("Заявка").Range("C14") = b1.Sheets("Заявка").Range("C14")

ThisWorkbook.Activate
ThisWorkbook.Application.Workbooks(b2.Name).SaveAs "C:\testCoef2\" & nName & " new"
ThisWorkbook.Application.Workbooks(b2.Name).Close False
ThisWorkbook.Application.Workbooks(b1.Name).Close False
Set b1 = Nothing
Set b2 = Nothing

End Sub