时间戳

首页 > 解决方案 > 如何使用打开对话框从文件夹中导入批量图片以选择整个文件夹并为每张图片制作新幻灯片

vba - 如何使用打开对话框从文件夹中导入批量图片以选择整个文件夹并为每张图片制作新幻灯片

问题描述

我正在尝试自动化 Powerpoint 演示。我在网上找到了一个代码。此代码运行良好，但它适用于代码中的静态路径。我想使用 OpenFolder 对话框来实现它。这个想法是，当我单击按钮导入图片时，应该打开文件对话框并选择文件夹。文件夹内的图片自动和图片的大小应自动适合幻灯片。此过程完成后，幻灯片放映会自动开始使用淡入淡出动画显示图片。代码如下。

Sub main()
Dim i As Integer
Dim arrFilesInFolder As Variant
arrFilesInFolder = GetAllFilesInDirectory("C:\Users\Admin\OneDrive\Pictures\Screenshots")

For i = LBound(arrFilesInFolder) To UBound(arrFilesInFolder)
    Call AddSlideAndImage(arrFilesInFolder(i))
Next
End Sub
Private Function GetAllFilesInDirectory(ByVal strDirectory As String) As Variant
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim arrOutput() As Variant
Dim i As Integer

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(strDirectory)
ReDim arrOutput(0)
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
 
    'print file path
    arrOutput(i - 1) = objFile.Path
    ReDim Preserve arrOutput(UBound(arrOutput) + 1)
    i = i + 1
Next objFile
   ReDim Preserve arrOutput(UBound(arrOutput) - 1)
GetAllFilesInDirectory = arrOutput
End Function

Private Function AddSlideAndImage(ByVal strFile As String)
Dim objPresentaion As presentation
Dim objSlide As slide

Set objPresentaion = ActivePresentation

Set objSlide = objPresentaion.Slides.Add(1, PpSlideLayout.ppLayoutChart)
Call objSlide.Shapes.AddPicture(strFile, msoCTrue, msoCTrue, 100, 100, 650, 450)
End Function

请有人指导，我在哪里做错了。谢谢

标签： vbapowerpoint

解决方案

看起来您需要用提示用户输入的代码替换硬编码的文件路径。似乎Application.FileDialog应该让你到达那里：

Dim path As String
With Application.FileDialog(Type:=msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    If .Show Then
        path = .SelectedItems(1)
    Else
        'user cancelled, bail out:
        Exit Sub
    End If
End With

Dim arrFilesInFolder As Variant
arrFilesInFolder = GetAllFilesInDirectory(path)
'...rest of the code...

推荐阅读