Нужно скопировать слайды PowerPoint в таблицу в Word - PullRequest
Новая
       4

Нужно скопировать слайды PowerPoint в таблицу в Word

0 голосов
/ 04 июня 2019

Я хочу скопировать все слайды и заметки слайдов из PowerPoint в таблицу в документе Word - столбец 1 таблицы будет иметь изображение слайда, столбец 2 - текст примечания.(Это эмулирует функциональность «создания раздаточных материалов» из PPT, но дает мне лучший контроль над форматированием в слове.)

Я начал код, сосредоточенный только на копировании слайдов, но PPT vba не позволит мнеуказать функцию диапазона - поэтому у меня возникают проблемы с получением кода для вставки слайда в столбце 1.

Вот что у меня есть.Это копирует все слайды - но не помещается в таблицу / col1.Я еще не добавил код для заметок - хотел сначала сделать слайды. 

    Sub CopyToWord()

    Dim WdApp As Object
    Dim WdDoc As Object
    Dim r As Integer  'used to track table row

    Dim s As Slide

    Dim myTable As Table

    Dim FontName As String
    Dim FontSize As Integer
    Dim FontColor As String


 'create Word Document
 Err.Clear
    On Error Resume Next

 Set WdApp = GetObject(Class:="Word.Application")
   If Err <> 0 Then
        Set WdApp = CreateObject("Word.Application")
   End If


 WdApp.Visible = True
 Set WdDoc = WdApp.Documents.Add


'Create 2 Column Table and set column widths

ActiveDocument.Tables.Add Range:=myRange, NumRows:=1, NumColumns:=2

Selection.Tables(1).Columns(1).SetWidth ColumnWidth:=175, RulerStyle:= _
    wdAdjustNone

Selection.Tables(1).Columns(2).SetWidth ColumnWidth:=380, RulerStyle:= _
    wdAdjustNone


 'copy each slide to table Col 1
 ActiveDocument.Tables(1).Select
 Set myTable = Selection.Tables(1)
 r = 1

 For Each s In ActivePresentation.Slides
        s.Copy
        ActiveDocument.Tables(1).Rows(r).Cells(1).Select
        WdApp.Selection.Paste
        Selection.InsertRowsBelow (1)
        r = r + 1
 Next


'Add Borders

    ActiveDocument.Tables(1).Select
    With Selection.Borders(wdBorderTop)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderLeft)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderBottom)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderRight)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderHorizontal)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderVertical)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With

End Sub

Спасибо за вашу помощь!

...