Суть его работы - выбор одного из встроенных скриптов: - для файлов формата word - нужно запустить скрипт objWord - для файлов формата excel - нужно запустить скрипт objExcel
objWord и objExcel выполняют при запуске пересохранение файлов соответствующего формата из одного каталога в другой (в процессе копирования в новые файлы производится вставка значений)
пути старых и новых файлов указаны в самом файле со встроенными скриптами: - в ячейке C30 файла ".xlsm" - в ячейке C33 файла ".xlsm"
Помогите, пожалуйста прописать условие: если расширение файла, указанного в ячейке C33 равно ".doc" или ".docx", то запускается скрипт objWord, если нет, то запускается скрипт objExcel
Вот сам скрипт obj_select:
Код
Sub obj_select()
' макрос для выбора скрипта в зависимости от типа исходного шаблона (Word или Excel);
If (Условие_1) Then
Application.Run "'1.xlsm'!objWord.objWord"
Else
Application.Run "'1.xlsm'!objExcel.objExcel"
End If
End Sub
Скрипт objWord
Код
Sub objWord() 'скрипт создания файла word на основании таблицы excel
Dim objWord As Object
Dim FileStart
Dim FileNew
'обновление ячейки для добавления времени в имя файла
Range("E29").FormulaR1C1 = "=NOW()"
Set objWord = CreateObject("Word.Application")
FileSt = Range("C30").Value 'исходный файл (шаблон), можно указать путь "g:\2.docx" или "\\fuib.com\kho\DOCUMENTYOOKUTU\..."
FileNew = Range("C33").Value 'новый файл, можно указать путь "g:\5.docx" или "\\fuib.com\kho\DOCUMENTYOOKUTU\..." (с внесёнными закладками word - "Вставка" - "Закладки")
Set objDoc = objWord.Documents.Open(FileSt)
objWord.Visible = False 'если вместо objWord.Visible = True написать objWord.Visible = False, то Шаблон Word появляться не будет
objDoc.Bookmarks("okpo").Range.InsertAfter (Cells(35, 3).Value)
On Error Resume Next
objDoc.Bookmarks("nazv_kr").Range.InsertAfter (Cells(36, 3).Value)
On Error Resume Next
objWord.ActiveDocument.SaveAs _
Filename:=FileNew, _
FileFormat:=wdFormatDocument, _
Password:="", _
AddToRecentFiles:=True, _
WritePassword:="", _
ReadOnlyRecommended:=False
objWord.Quit
Dim objWrdApp As Object 'открытие нового файла
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open(FileNew)
objWord.Visible = True 'если вместо objWord.Visible = True написать objWord.Visible = False, то Шаблон Word появляться не будет
'активация окна word
objWord.Activate
'пауза 2 сек.
Application.Wait (Now() + TimeValue("00:00:02"))
'открытие "Проводника" в папке;
Shell "cmd /C start """" ""\\fuib.com\kho\DOCUMENTYOOKUTU\Кулиничев\! открытие счетов\avto\готовые документы\""", vbNormalFocus
End Sub
Скрипт objExcel
Код
Sub objExcel() 'скрипт копирования файла excel из таблицы excel и заполнение ячеек на основании таблицы excel
Dim objExcel As Object
Dim FileStart
Dim FileNew
'обновление ячейки для добавления времени в имя файла
Range("E29").FormulaR1C1 = "=NOW()"
Set objExcel = CreateObject("Excel.Application")
'исходный файл (шаблон), можно указать путь "g:\2.xlsx" или "\\fuib.com\kho\DOCUMENTYOOKUTU\..."
FileSt = Range("C30").Value
'новый файл, можно указать путь "g:\5.xlsx" или "\\fuib.com\kho\DOCUMENTYOOKUTU\..."
FileNew = Range("C33").Value
Set objWorkbook = Workbooks.Open(FileSt)
'если написать objExcel.Application.Visible = True, то Шаблон появляться будет
objExcel.Application.Visible = False
ActiveWorkbook.SaveAs _
Filename:=FileNew, _
FileFormat:=xlOpenXMLWorkbook, _
CreateBackup:=False
objExcel.Quit
'открытие нового файла
Dim objExcelApp As Object
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = Workbooks.Open(FileNew)
objExcel.Visible = True 'если написать oobjExcel.Visible = False, то Шаблон появляться не будет
'активация окна нового файла
Workbooks(2).Activate
ActiveWindow.WindowState = xlMaximized
'пауза 2 сек.
Application.Wait (Now() + TimeValue("00:00:02"))
'открытие "Проводника" в папке;
Shell "cmd /C start """" ""\\fuib.com\kho\DOCUMENTYOOKUTU\Кулиничев\! открытие счетов\avto\готовые документы\""", vbNormalFocus
End Sub
If Right(file_name, 4) = ".doc" Then
'Действия для doc
Else If Right(file_name, 4) = "docx" Then
'Действия для docx
Else
'Действия если ни docx, ни doc
End If