时间戳

首页 > 解决方案 > Powerpoint VBA 选择图像文件夹，将这些图像放在幻灯片上

vba - Powerpoint VBA 选择图像文件夹，将这些图像放在幻灯片上

问题描述

如何使第二组代码引用在第一组中所做的选择，而不是它当前使用的硬编码位置？这两组完全符合我的喜好，最终我想将它们组合起来，但只是想不出如何让第二组使用第一组的路径。我已经搜索了几天，并尝试了我能想到的一切。它必须是我忽略的一件简单的事情。

    Sub SelectFolder()
    Dim sFolder As String
        ' Open the select folder prompt
        With Application.FileDialog(msoFileDialogFolderPicker)
            If .Show = -1 Then ' if OK is pressed
                sFolder = .SelectedItems(1)
            End If
        End With

        If sFolder <> "" Then ' if a file was chosen
            ' *********************
            ' put your code in here
            ' *********************
        End If
    End Sub

''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''

    Sub EveryPresentationInFolder()'Performs some operation on every 
                                   'presentation file in a folder adapted from PPTools.com


       Dim sFolder As String      ' Full path to folder we'll examine
       Dim sFileSpec As String      ' Filespec, e.g. *.PNG
       Dim sFileName As String      ' Name of a file in the folder
       Dim oPres As Presentation
       Dim lngSld As Long
       Dim rayNum() As String
       Dim sngL As Single
       Dim sngT As Single
       Dim sngW As Single
       Dim opic As Shape


       sFolder = Environ("USERPROFILE") & "\Desktop\Images\" ' This is where I want the folder ive picked
       sFileSpec = "*.PNG"
       Set oPres = ActivePresentation
       sngL = 0
       sngT = 0.6 * 28.3465
       sngW = oPres.PageSetup.SlideWidth
       sFileName = Dir$(sFolder & sFileSpec)
       While sFileName <> ""
          Debug.Print sFileName
          rayNum = Split(sFileName, ".")
          lngSld = CLng(rayNum(0))
          If lngSld <= oPres.Slides.Count Then
             Set opic = oPres.Slides(lngSld).Shapes.AddPicture(FileName:=sFolder & sFileName, _
                                                       LinkToFile:=False, _
                                                       SaveWithDocument:=True, _
                                                       Left:=sngL, _
                                                       Top:=sngT, _
                                                       Width:=sngW)
             opic.LockAspectRatio = True
             opic.Width = sngW
             opic.Left = 0
             opic.Top = sngT
             opic.ZOrder (msoSendToBack)
          End If
          sFileName = Dir()
       Wend
    End Sub

我接受了建议，并试图让新信息对我有用。我知道它只是元素的排序，我觉得我很接近，但我不明白这个问题。为什么这行不通？

   Function SelectFolder() As String
Dim sFolder As String
    ' Open the select folder prompt
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then ' if OK is pressed
            sFolder = .SelectedItems(1)
        End If
    End With
    If sFolder <> "" Then ' if a file was chosen
        SelectFolder = sFolder
        
    Else
        SelectFolder = ""
    End If

   Dim sFileSpec As String      ' Filespec, e.g. *.PNG
   Dim sFileName As String      ' Name of a file in the folder
   Dim oPres As Presentation
   Dim lngSld As Long
   Dim rayNum() As String
   Dim sngL As Single
   Dim sngT As Single
   Dim sngW As Single
   Dim opic As Shape


   sFolder = SelectFolder ' This is where I want the folder ive picked
   sFileSpec = "*.jpg"
   Set oPres = ActivePresentation
   sngL = 0
   sngT = 0.6 * 28.3465
   sngW = oPres.PageSetup.SlideWidth
   sFileName = Dir$(sFolder & sFileSpec)
   While sFileName <> ""
      Debug.Print sFileName
      rayNum = Split(sFileName, ".")
      lngSld = CLng(rayNum(0))
      If lngSld <= oPres.Slides.Count Then
         Set opic = oPres.Slides(lngSld).Shapes.AddPicture(FileName:=sFolder & sFileName, _
                                                   LinkToFile:=False, _
                                                   SaveWithDocument:=True, _
                                                   Left:=sngL, _
                                                   Top:=sngT, _
                                                   Width:=sngW)
         opic.LockAspectRatio = True
         opic.Width = sngW
         opic.Left = 0
         opic.Top = sngT
         opic.ZOrder (msoSendToBack)
      End If
      sFileName = Dir()
   Wend
End Function

标签： vbapowerpoint

解决方案

重新“我如何调用位置而不是 sFolder=Environ”

将其更改为：

sFolder = SelectFolder

然后将 Sub SelectFolder 更改为函数：

Function SelectFolder() as String
    Dim sFolder As String
        ' Open the select folder prompt
        With Application.FileDialog(msoFileDialogFolderPicker)
            If .Show = -1 Then ' if OK is pressed
                sFolder = .SelectedItems(1)
            End If
        End With

        If sFolder <> "" Then ' if a file was chosen
            SelectFolder = sFolder
            ' *********************
            ' put your code in here
            ' *********************
        Else
            SelectFolder = ""
        End If
    End Sub

推荐阅读