Доброго времени суток! Есть один небольшой скрипт, суть его работы:
1) есть основной файл "1.xlsm", в который внесены данные для заполнения шаблоном документов на основании заранее подготовленных значений (заполнение значительной части документов производится в Word на основании сопоставления "Закладок" в этом приложении), т.е. этот скрипт копирует файл из одного каталога в другой с внесением в него определённых значений в заранее вставленные "Закладки" файла Word
скрипт находится в файле "1.xlsm"
2) после выполнения скрипта получается 3 файла: - "1.xlsm" со скриптом - исходный шаблон ".... .doc" размещён в одном каталоге (адрес данного файла указан в ячейке C30 файла "1.xlsm") - новый файл ".... .doc" помещается в другом каталоге (адрес данного файла указан в ячейке C33 файла "1.xlsm")
3) по итогу: - активируется окно приложения Word и открывается окно "Проводника", где сохранён новый файл. далее сотрудник, которому нужен заполненный шаблон переносит его куда-то в другой каталог (или отправляет кому-то на почту), т.е. по своему усмотрению
Но появились шаблоны некоторых документов и в Excel, в не Word, для которых я сделал похожий скрипт (текст ниже) и возникли небольшие проблемы при его выполнении:
1) код "objExcel.Application.Visible = False" должен скрывать окно программы Excel при внесении данных, но окно Excel появляется на 1-2 секунды и потом закрывается
2) код "Workbooks(2).ActivateActive" и "Window.WindowState = xlMaximized" должен активировать окно с новым файлом Excel, но активации окна не производится. код "Windows(".....xls").Activate" не подходит, т.к. имя новой таблицы может меняться и указано это только в ячейке C31 файла "1.xlsm", т.е. вручную каждый раз прописывать не вариант
Помогите, пожалуйста, разобраться с этими проблемками ...
Скрины прилагаю
Заранее спасибо
Код
Sub obj2() 'скрипт копирования файла 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
' описание файлов при сохранении https://www.mrexcel.com/board/threads/vba-saveas-fileformat-variable.759381/
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"))
'открытие "Проводника" в папке; источник https://vremya-ne-zhdet.ru/vba-excel/otkryt-papku-v-provodnike/#Otkrytie_papki_v_provodnike
Shell "cmd /C start """" ""\\fuib.com\kho\DOCUMENTYOOKUTU\Кулиничев\! открытие счетов\avto\готовые документы\""", vbNormalFocus
End Sub
Без полноценного примера сложно определить, что именно надо. Попробуем погадать. Как вариант, в макросе убрать все CreateObject("Excel.Application"), а создавать новые книги просто Workbooks.Add.
Sub Test()
Dim Sh As Worksheet, wb As Workbook, FileStart As String, FileNew As String
Application.ScreenUpdating = False
Set Sh = ThisWorkbook.Worksheets("1")
FileSt = Sh.Range("C30").Value
FileNew = Sh.Range("C33").Value
Set wb = Workbooks.Open(FileSt)
wb.SaveAs Filename:=FileNew, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
wb.Activate
Application.Wait (Now() + TimeValue("00:00:02"))
Shell "cmd /C start """" ""\\fuib.com\kho\DOCUMENTYOOKUTU\Кулиничев\! открытие счетов\avto\готовые документы\""", vbNormalFocus
ThisWorkbook.Close (True)
Application.ScreenUpdating = True
End Sub