Перевод "фокуса" на файл созданный Шаблоном
Модератор: Naeel Maqsudov
Private Sub Команда_Click()
On Error Resume Next
Workbooks("Проба.xls").Activate
If Err.Number = 9 Then
Workbooks.Open (Путь_Проба)
Else
Workbooks(Путь_Проба).Activate
End If
On Error GoTo 0
…………………………
Set w = CreateObject("Word.Application")
w.Documents.Add Форма.Сообщение. value
Application.ScreenUpdating = False
w.Visible = True
w.activedocument.Bookmarks("Вставка1").Select
w.Selection.TypeText Me.1.Text
…………………………………
Application.ScreenUpdating = True
.......................
Добрый день форумчане!
[INDENT]Прошу помощи в решении небольшого вопроса! Имеется команда выполняющая следующие действия:
САМ ФАЙЛ из которого выполняется команда Excel
1. При нажатии на кнопку выполнения команды, открывается еще один файл Excel, в котором происходят некоторые манипуляции и ФАЙЛ ОСТАЕТСЯ ОТКРЫТЫМ[/INDENT]
2. Создается файл Word из Шаблона, который после внесения изменений с помощью Bookmarks, необходимо сохранить в определенном месте:
есть небольшой код для этого:
Dim FPath As String, FName As String
Set q = ThisWorkbook.Sheets("Лист2").Columns("A").Find(what:=ФИО.Value)
If ThisWorkbook.Sheets("Лист2").Cells(q.Row, 12).Value <> "" Then
FPath = ThisWorkbook.Sheets("Лист2").Cells(q.Row, 12).Value + "\"
Else
' MsgBox "Путь к папке клиента не найден выберите папку для сохранения в ручную", vbOKOnly + vbExclamation, "NOT FIND"
' FPath = "P:\..........."
'End If
' FName = "Файл" + " " + q
' FName = Application.GetSaveAsFilename(InitialFileName:=FPath & FName, _
' fileFilter:="word Files (*.doc), *.dot")
' If FName <> "" Then If FName <> "False" Then ActiveWorkbook.SaveAs Filename:=FName
но не могу понять как в данном коде сфокусироваться именно на Word файле! Так как в VBA понимаю не особо перепробовал множество разных вариантов в
FName = Application.GetSaveAsFilename(InitialFileName:=FPath & FName, _
' fileFilter:="word Files (*.doc), *.dot")
вместо Application.GetSaveAsFilename ставил w.Documents, Application.activedocument и т.д., при команде по моему Application.activedocument фокус падает на открытый первоначально (в данном примере у меня Проба.xls) файл Excel.
[INDENT]Кто может помогите, может капаю не там! в результате хотелось бы видеть автоматическое сохранения файла Word в папке клиента после выполнения в нем Bookmarks'ов без вопросов, а вопрос возникал бы только при отсутствии папки клиента по вышеуказанному адресу! [/INDENT]
[INDENT]Если не понятно, готов выложить файлик!! ЗАРАНЕЕ СПАСИБО ВСЕМ![/INDENT]
On Error Resume Next
Workbooks("Проба.xls").Activate
If Err.Number = 9 Then
Workbooks.Open (Путь_Проба)
Else
Workbooks(Путь_Проба).Activate
End If
On Error GoTo 0
…………………………
Set w = CreateObject("Word.Application")
w.Documents.Add Форма.Сообщение. value
Application.ScreenUpdating = False
w.Visible = True
w.activedocument.Bookmarks("Вставка1").Select
w.Selection.TypeText Me.1.Text
…………………………………
Application.ScreenUpdating = True
.......................
Добрый день форумчане!
[INDENT]Прошу помощи в решении небольшого вопроса! Имеется команда выполняющая следующие действия:
САМ ФАЙЛ из которого выполняется команда Excel
1. При нажатии на кнопку выполнения команды, открывается еще один файл Excel, в котором происходят некоторые манипуляции и ФАЙЛ ОСТАЕТСЯ ОТКРЫТЫМ[/INDENT]
2. Создается файл Word из Шаблона, который после внесения изменений с помощью Bookmarks, необходимо сохранить в определенном месте:
есть небольшой код для этого:
Dim FPath As String, FName As String
Set q = ThisWorkbook.Sheets("Лист2").Columns("A").Find(what:=ФИО.Value)
If ThisWorkbook.Sheets("Лист2").Cells(q.Row, 12).Value <> "" Then
FPath = ThisWorkbook.Sheets("Лист2").Cells(q.Row, 12).Value + "\"
Else
' MsgBox "Путь к папке клиента не найден выберите папку для сохранения в ручную", vbOKOnly + vbExclamation, "NOT FIND"
' FPath = "P:\..........."
'End If
' FName = "Файл" + " " + q
' FName = Application.GetSaveAsFilename(InitialFileName:=FPath & FName, _
' fileFilter:="word Files (*.doc), *.dot")
' If FName <> "" Then If FName <> "False" Then ActiveWorkbook.SaveAs Filename:=FName
но не могу понять как в данном коде сфокусироваться именно на Word файле! Так как в VBA понимаю не особо перепробовал множество разных вариантов в
FName = Application.GetSaveAsFilename(InitialFileName:=FPath & FName, _
' fileFilter:="word Files (*.doc), *.dot")
вместо Application.GetSaveAsFilename ставил w.Documents, Application.activedocument и т.д., при команде по моему Application.activedocument фокус падает на открытый первоначально (в данном примере у меня Проба.xls) файл Excel.
[INDENT]Кто может помогите, может капаю не там! в результате хотелось бы видеть автоматическое сохранения файла Word в папке клиента после выполнения в нем Bookmarks'ов без вопросов, а вопрос возникал бы только при отсутствии папки клиента по вышеуказанному адресу! [/INDENT]
[INDENT]Если не понятно, готов выложить файлик!! ЗАРАНЕЕ СПАСИБО ВСЕМ![/INDENT]
- Naeel Maqsudov
- Сообщения: 2570
- Зарегистрирован: 20 фев 2004, 19:17
- Откуда: Moscow, Russia
- Контактная информация:
w.Activate
Наиль спасибо, но не совсем получается, подскажите, а куда вставить данное ворожение? потому что когда вставляю в
FName = Application.GetSaveAsFilename(InitialFileName:=FPa th & FName, _
' fileFilter:="word Files (*.doc), *.dot") вместо Application:
w.Activate.GetSaveAsFilename(InitialFileName:=FPa th & FName, _
' fileFilter:="word Files (*.doc), *.dot")
или так
Application.w.Activate.GetSaveAsFilename(InitialFileName:=FPa th & FName, _
' fileFilter:="word Files (*.doc), *.dot")
выдает ошибку
FName = Application.GetSaveAsFilename(InitialFileName:=FPa th & FName, _
' fileFilter:="word Files (*.doc), *.dot") вместо Application:
w.Activate.GetSaveAsFilename(InitialFileName:=FPa th & FName, _
' fileFilter:="word Files (*.doc), *.dot")
или так
Application.w.Activate.GetSaveAsFilename(InitialFileName:=FPa th & FName, _
' fileFilter:="word Files (*.doc), *.dot")
выдает ошибку
Все, понял в чем был косяк! Спасибо большое, "что ткнули носом"!
Остался только маленький вопрос о котором писал выше:
.....в результате хотелось бы видеть автоматическое сохранения файла Word в папке клиента после выполнения в нем Bookmarks'ов без вопросов (Подтверждения имени файла), а вопрос возникал бы только при отсутствии папки клиента по вышеуказанному адресу!
Остался только маленький вопрос о котором писал выше:
.....в результате хотелось бы видеть автоматическое сохранения файла Word в папке клиента после выполнения в нем Bookmarks'ов без вопросов (Подтверждения имени файла), а вопрос возникал бы только при отсутствии папки клиента по вышеуказанному адресу!
- Naeel Maqsudov
- Сообщения: 2570
- Зарегистрирован: 20 фев 2004, 19:17
- Откуда: Moscow, Russia
- Контактная информация:
Не понял.
.SaveAs
не приводит к появлению диалоговых окон даже если такой файл на диске уже существует
.SaveAs
не приводит к появлению диалоговых окон даже если такой файл на диске уже существует
Naeel Maqsudov писал(а):Не понял.
.SaveAs
не приводит к появлению диалоговых окон даже если такой файл на диске уже существует
Да согласен, но вылезает окно сохранить как......[ATTACH]1507[/ATTACH], думаю это из-за
FName = Application.GetSaveAsFilename(InitialFileName:=FPa th & FName, _
' fileFilter:="word Files (*.doc), *.dot")
Я согласен что файл сохраняется с нужным мне именем (FName = "Файл" + " " + q) и по необходимому пути (FPath = ThisWorkbook.Sheets("Лист2").Cells(q.Row, 12).Value + "\"), но мне бы хотелось бы чтобы окно Сохранить как... выскакивало только в случае, если в ячейке с путем к папке (FPath = ThisWorkbook.Sheets("Лист2").Cells(q.Row, 12).Value + "\") не были бы забиты данные, а так бы файл тихо и спокойно сохранялся в необходимой папке.
- Naeel Maqsudov
- Сообщения: 2570
- Зарегистрирован: 20 фев 2004, 19:17
- Откуда: Moscow, Russia
- Контактная информация:
Ну, раз знаете, как хотите, то так и пишите. 
Можно заранее проверять существование пути, а можно просто вызывать SaveAs и ловить исключение

Можно заранее проверять существование пути, а можно просто вызывать SaveAs и ловить исключение
Код: Выделить всё
'попытаемся сохранить
On Error Resume Next
ActiveDocument.SaveAs "c:\123"
If Err.Number <> 0 Then
On Error GoTo 0
'если не получилось, то тут
'напишем, что делать
'...
Else
On Error GoTo 0
End If
Наиль спасибо за помощь! Реализовал код следующим образом:
Dim FPath As String, FName As String
Set q = ThisWorkbook.Sheets("Лист2").Columns("A").Find(what:=Me.ФИО.Value)
FName = "Файл" + " " + q
If ThisWorkbook.Sheets("Лист2").Cells(q.Row, 12).Value <> "" Then
FPath = ThisWorkbook.Sheets("Лист2").Cells(q.Row, 12).Value + "\"
W.ActiveDocument.SaveAs Filename:=FPath + FName
Else
MsgBox "Папка не найдена, выберите папку в ручную ", vbOKOnly + vbExclamation, "NOT FIND"
FPath = "P:\........"
FName = Application.GetSaveAsFilename(InitialFileName:=FPath & FName, _
fileFilter:="word Files (*.doc), *.dot")
If FName <> "" Then If FName <> "False" Then W.ActiveDocument.SaveAs Filename:=FName
Set W = Nothing
Может конечно криво написано, но самое главное результат, а результат....РАБОТАЕТ!!!! УРА!!!
[CENTER]ТЕМА ЗАКРЫТА[/CENTER]
Dim FPath As String, FName As String
Set q = ThisWorkbook.Sheets("Лист2").Columns("A").Find(what:=Me.ФИО.Value)
FName = "Файл" + " " + q
If ThisWorkbook.Sheets("Лист2").Cells(q.Row, 12).Value <> "" Then
FPath = ThisWorkbook.Sheets("Лист2").Cells(q.Row, 12).Value + "\"
W.ActiveDocument.SaveAs Filename:=FPath + FName
Else
MsgBox "Папка не найдена, выберите папку в ручную ", vbOKOnly + vbExclamation, "NOT FIND"
FPath = "P:\........"
FName = Application.GetSaveAsFilename(InitialFileName:=FPath & FName, _
fileFilter:="word Files (*.doc), *.dot")
If FName <> "" Then If FName <> "False" Then W.ActiveDocument.SaveAs Filename:=FName
Set W = Nothing
Может конечно криво написано, но самое главное результат, а результат....РАБОТАЕТ!!!! УРА!!!
[CENTER]ТЕМА ЗАКРЫТА[/CENTER]