VBA

移动（剪切和粘贴）Powerpoint幻灯片与部分信息我正在寻找一种解决方案来选择一些幻灯片和剪切或复制和粘贴在另一个位置，同时保持部分信息。我已经看到PPT不支持开箱即用（请参阅http://answers.microsoft.com/en-us/office/forum/office_2013_release-powerpoint/copying-sections-to-a-new-powerpoint/2c723b0d-d465-4ab6-b127-6fdfc195478c?db=5）并且还有一些VBA脚本示例Exporting PowerPoint sections into separate files PPTalchemy提供了一些插件，但不幸的是代码不可用。看到这里http://www.pptalchemy.co.uk/powerpoint_hints_and_tips_tutorials.html#2010 VBA

此外，它不适合在同一个演示文稿中轻松移动节。

任何想法如何做到这一点？

非常感谢。蒂埃里

来源

2016-06-09 Thierry Dalon

当粘贴到不同的幻灯片索引位置时，您会发生什么？如果粘贴到某个部分中，则无需执行任何操作（AFAIK，但需要检查），但是如果粘贴到另一部分，您是否希望创建一个与源部分同名的新部分？你试图达到什么样的需求？ –

好问题。我试图实现的是移动多个部分（以及所有的幻灯片）。我会在“全部折叠”部分视图中执行此操作，或者在选择之前的部分前粘贴。我希望能够以这种方式重新组织我的演示文稿。想象一下，我的演示文稿中有第1部分，第2部分，第3部分，第4部分，第5部分，我想将其逻辑/结构更改为第1部分，第4部分，第5部分，第2部分，第3部分。本案在第1部分之后或第2部分之前“移动”第4部分和第5部分。 –

这是最后的code我用移动幻灯片选择的多个部分：

Sub MoveSelectedSections() 
' Slides are copied ready to be pasted 
Dim lngNewPosition As Long 
'Debug.Print "" 
'Debug.Print "###Move Sections..." 
lngNewPosition = InputBox("Enter a destination section index:") 
lngNewPosition = CInt(lngNewPosition) ' Convert String to Int 
Call MoveSectionsSelectedBySlides(ActivePresentation, lngNewPosition) 

End Sub 


Function MoveSectionsSelectedBySlides(oPres As Presentation, lNewPosition As Long) 
    On Error GoTo errorhandler 

    ' Activate input presentation 
    oPres.Windows(1).Activate 

    ' Get Selected Sections Indexes 

    ' http://www.thespreadsheetguru.com/the-code-vault/2014/4/3/copy-selected-slides-into-new-powerpoint-presentation 

    Dim i, cnt As Integer 
    Dim SelectedSlides As SlideRange 
    Dim SectionIndexes() As Long 

    If ActiveWindow.Selection.Type <> ppSelectionSlides Then 
     MsgBox "No slides selected" 
     Exit Function 
    End If 

    Set SelectedSlides = ActiveWindow.Selection.SlideRange 
    ' selection order is reverse see http://www.pptfaq.com/FAQ00869_Create_a_custom_show_from_current_slide_selection_using_VBA.htm 


    'Fill an array with sectionIndex numbers 
    ReDim SectionIndexes(1 To SelectedSlides.Count) 
    cnt = 0 
    For i = 1 To SelectedSlides.Count 
    ' Check if already present in array 
     If Not Contains(SectionIndexes, SelectedSlides(i).sectionIndex) Then 
     cnt = cnt + 1 
     SectionIndexes(cnt) = SelectedSlides(i).sectionIndex 
     End If 
    Next i 
    ReDim Preserve SectionIndexes(1 To cnt) 


    ' Move Sections to lNewPosition, first last 
    For i = 1 To cnt 
     With oPres 
      .SectionProperties.Move SectionIndexes(i), lNewPosition 
     End With 
     Debug.Print "Section #" & SectionIndexes(i) & " moved to " & lNewPosition 
    Next i 



Exit Function 
errorhandler: 
    Debug.Print "Couldn't move section due to the following error: " & Err & ", " & Err.Description 
End Function 





Function Contains(arr, v) As Boolean 
' http://stackoverflow.com/a/18769246/2043349 
Dim rv As Boolean, i As Long ' Default value of boolean is False 
For i = LBound(arr) To UBound(arr) 
    If arr(i) = v Then 
     rv = True 
     Exit For 
    End If 
Next i 
Contains = rv 
End Function

来源

2016-06-30 12:04:55

要将演示文稿中移动部分，包括部分中的所有幻灯片，请在致电段的指数这个过程被移动和它的新位置：

Option Explicit 

' ******************************************************************************** 
' VBA Macro for PowerPoint, written by Jamie Garroch of http://YOUpresent.co.uk/ 
' ******************************************************************************** 
' Purpose : Moves a specified section of slides to a new section location 
' Inputs : lSectionIndex - the index of the section to be moved 
'   lNewPosition - the index of the position to move to 
' Outputs : None. 
' ******************************************************************************** 
Public Sub MoveSection(lSectionIndex As Long, lNewPosition As Long) 
    On Error GoTo errorhandler 
    With ActivePresentation 
    .SectionProperties.Move lSectionIndex, lNewPosition 
    End With 
Exit Sub 
errorhandler: 
    Debug.Print "Couldn't move section due to the following error: " & Err & ", " & Err.Description 
End Sub

来源

2016-06-16 08:18:56

回答

相关问题