如何从文件夹中导入选定的演示文稿?
How to import selected presentations from a folder?
如何从特定文件夹导入选定的演示文稿?
下面是我试过的代码,但它正在导入存储在特定文件夹中的所有演示文稿。
Sub Merge()
' After doing the merge, open presentation #1
' Then run this code:
Dim sPath As String
Dim cFileNames As New Collection
Dim sTemp As String
Dim x As Long
sPath = CurDir ' by default
If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
sPath = InputBox("Path to PPT files (ex: c:\my documents\", _
"Where are the files?", sPath)
If sPath = "" Then
Exit Sub
End If
sTemp = Dir(sPath & "*.pptx")
While sTemp <> ""
With cFileNames
.Add (sPath & sTemp)
End With
sTemp = Dir
Wend
If cFileNames.Count > 1 Then
' open the first file
Presentations.Open (cFileNames(1))
' Insert the other files
For x = 2 To cFileNames.Count
Call ActivePresentation.Slides.InsertFromFile( _
cFileNames(x), _
ActivePresentation.Slides.Count)
Next
End If
End Sub
例如。我在 XYZ 文件夹 中有 10 个演示文稿,但只想导入四个选定的演示文稿。
应该这样做:
Sub Merge()
Dim sPath As String
Dim dlgOpen As FileDialog
Dim x As Integer
Dim vrtSelectedItem As Variant
'Set path to current dirrectory
sPath = CurDir
If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
'Set File Picker dialog
Set dlgOpen = Application.FileDialog(Type:=msoFileDialogFilePicker)
'Set initial path and view, set multiselect capability
With dlgOpen
.InitialFileName = sPath
.InitialView = msoFileDialogViewList
.AllowMultiSelect = True
'If user click on OK, insert selected files after last slide of current presentation
If .Show = -1 And .SelectedItems.Count > 0 Then
For x = 1 To .SelectedItems.Count
ActivePresentation.Slides.InsertFromFile .SelectedItems(x), ActivePresentation.Slides.Count
Next
Else
'User Cancelled
End If
End With
End Sub
如何从特定文件夹导入选定的演示文稿?
下面是我试过的代码,但它正在导入存储在特定文件夹中的所有演示文稿。
Sub Merge()
' After doing the merge, open presentation #1
' Then run this code:
Dim sPath As String
Dim cFileNames As New Collection
Dim sTemp As String
Dim x As Long
sPath = CurDir ' by default
If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
sPath = InputBox("Path to PPT files (ex: c:\my documents\", _
"Where are the files?", sPath)
If sPath = "" Then
Exit Sub
End If
sTemp = Dir(sPath & "*.pptx")
While sTemp <> ""
With cFileNames
.Add (sPath & sTemp)
End With
sTemp = Dir
Wend
If cFileNames.Count > 1 Then
' open the first file
Presentations.Open (cFileNames(1))
' Insert the other files
For x = 2 To cFileNames.Count
Call ActivePresentation.Slides.InsertFromFile( _
cFileNames(x), _
ActivePresentation.Slides.Count)
Next
End If
End Sub
例如。我在 XYZ 文件夹 中有 10 个演示文稿,但只想导入四个选定的演示文稿。
应该这样做:
Sub Merge()
Dim sPath As String
Dim dlgOpen As FileDialog
Dim x As Integer
Dim vrtSelectedItem As Variant
'Set path to current dirrectory
sPath = CurDir
If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
'Set File Picker dialog
Set dlgOpen = Application.FileDialog(Type:=msoFileDialogFilePicker)
'Set initial path and view, set multiselect capability
With dlgOpen
.InitialFileName = sPath
.InitialView = msoFileDialogViewList
.AllowMultiSelect = True
'If user click on OK, insert selected files after last slide of current presentation
If .Show = -1 And .SelectedItems.Count > 0 Then
For x = 1 To .SelectedItems.Count
ActivePresentation.Slides.InsertFromFile .SelectedItems(x), ActivePresentation.Slides.Count
Next
Else
'User Cancelled
End If
End With
End Sub