1

Тема: Макрос из power point открывает word на нужной странице

Добрый день! Необходимо открыть документ word из power point на нужной странице. То же самое нужно сделать с excel (на нужном листе)

Как открыть файл я знаю:
Sub ОткрытьДокументWord2()
On Error Resume Next
Set wa = CreateObject("Word.Application")
wa.Visible = True
Set WD = wa.Documents.Open("C:\1.docx")

Найти нужную страницу тоже понятно:
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="185"

Но как это соединить воедино, чтобы при открытии файла он сразу открывал мне 185 страницу. Не могу понять.

Сразу скажу, что макросы типа AutoOpen не подходят. Документ нужно будет открывать несколько раз на разных страницах.

Заранее спасибо!

2

Re: Макрос из power point открывает word на нужной странице

YKalinichenko пишет:

Добрый день! Необходимо открыть документ word из power point на нужной странице. То же самое нужно сделать с excel (на нужном листе)

Как открыть файл я знаю:
Sub ОткрытьДокументWord2()
On Error Resume Next
Set wa = CreateObject("Word.Application")
wa.Visible = True
Set WD = wa.Documents.Open("C:\1.docx")

Найти нужную страницу тоже понятно:
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="185"

Но как это соединить воедино, чтобы при открытии файла он сразу открывал мне 185 страницу. Не могу понять.

Сразу скажу, что макросы типа AutoOpen не подходят. Документ нужно будет открывать несколько раз на разных страницах.

Заранее спасибо!


Спустя 4 года. Объектная модель поинта довольно скупа. Лучше создать презентацию из ворд - поэтому макрос вставляете в тот документ ворд, который будет необходимо открывать и оттуда запускаете.

Sub docOp()
Dim sFullName, sName, doReplace, Получается, oTargetList As String
Dim oDocOpened As Document
Dim oExcelApp As Object
Dim oPowerPointApp As Object
Dim oListOpened As Object
Dim oPowerPoint As Object
Dim bFlag As Integer
'On Error GoTo ErrorHandler
Set oDocOpened = Application.ActiveDocument
doReplace = InputBox("Введите номер нужной страницы")
Selection.HomeKey Unit:=wdStory
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=doReplace - 1
Line1:
sFullName = oDocOpened.FullName
sName = oDocOpened.Name
doReplace = InputBox(Prompt:="Введите название файла Excel и нажмите (ОК)", Title:="Нужно ли открывать эксель?")
If Not doReplace = "" Then
Set oExcelApp = CreateObject("Excel.Application")
Set oListOpened = oExcelApp.Workbooks.Open(Replace(sFullName, sName, doReplace) & ".xlsx")
oExcelApp.Application.Visible = True
oListOpened.Sheets("Лист3").Select
End If
Line2:
doReplace = InputBox("Введите название презентации")
Set oPowerPointApp = CreateObject("PowerPoint.Application")
oPowerPointApp.Activate
Set oPowerPoint = oPowerPointApp.Presentations.Add()
oPowerPoint.SaveAs FileName:=Replace(sFullName, sName, doReplace) & ".ppt"
ErrorHandler:
Debug.Print Err.Number
If Err.Number = 1004 Then
bFlag = MsgBox(Prompt:="Ввести заново?", Buttons:=vbOKCancel, Title:="Такого файла не существует")
End If
    If bFlag = 1 Then
        GoTo Line1
    ElseIf bFlag = 2 Then
        GoTo Line2
    End If
End Sub