vba 宏将图像文件名加载到幻灯片而不是图像中

Question

我是新来的，希望得到您的帮助。 我有一个用于 PowerPoint 的宏加载项在旧版本中运行良好。 新的 365 办公室没有运行它；通过一些技巧，我能够解决大部分问题。 现在唯一剩下的就是当尝试打开并从文件夹中选择图像文件时，它会将图像名称加载到每张幻灯片中，而不是图像！

Sub Insert1PicViaForm()

' Added on 21.05.06 to load single file using code from
'
'  http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dnovba00/html/CommonDialogsPartI.asp
'
'
Dim OFN As OPENFILENAME
Dim Ret
Dim N As Integer
Dim ddd
Dim oSld As Slide
Dim oPic As Shape

  With OFN
    .lStructSize = LenB(OFN)     ' Size of structure.
    .nMaxFile = 574             ' Size of buffer.
    ' Create buffer.
    .lpstrFile = String(.nMaxFile - 1, 0)
    Ret = GetOpenFileName(OFN)  ' Call function.
    If Ret <> 0 Then            ' Non-zero is success.
      ' Find first null char.
      N = InStr(.lpstrFile, vbNullChar)
      ' Return what's before it.
      ' MsgBox Left(.lpstrFile, n - 1)
      ' Full path and filename
      ddd = Left(.lpstrFile, N - 1)
      ' Add slide at end of presentation
            
      Set oSld = ActivePresentation.Slides.Add(ActivePresentation.Slides.count + 1, ppLayoutBlank)
      ' Insert pic as selected
      Set oPic = oSld.Shapes.AddPicture(FileName:=ddd, _
              LinkToFile:=msoCTrue, _
              SaveWithDocument:=msoCTrue, _
              Left:=60, _
              Top:=35, _
              Width:=98, _
              Height:=48)

    End If
  End With
End Sub

Answer 1

关于您的代码的一些评论：

• 您缺少GetOpenFileName 函数。
• 现在打开文件对话框并返回文件路径很简单。无需读取和缓冲图片文件

请阅读代码的 cmets 并根据您的需要进行调整

Public Sub InsertPicture()

    ' Declare and set a variable to ask for a file
    Dim fileDialogObject As FileDialog
    Set fileDialogObject = Application.FileDialog(msoFileDialogFilePicker)
    
    ' Adjust file dialog properties
    With fileDialogObject
        .InitialFileName = "C:\Temp"
        .Title = "Insert Picture"
        .ButtonName = "Insert picture"
        .InitialView = msoFileDialogViewDetails
        .Filters.Add "Images", "*.gif; *.jpg; *.jpeg,*.png,*.eps,*.tif,*.tiff", 1
    End With
    
    ' Show the file dialog to user and wait for response
    If fileDialogObject.Show = False Then Exit Sub
    
    ' Loop through each selected file (selectedFile returns the file path string)
    Dim selectedFile As Variant
    For Each selectedFile In fileDialogObject.SelectedItems
    
        ' Set new slide layout
        Dim pptLayout As CustomLayout
        Set pptLayout = ActivePresentation.Slides(1).CustomLayout
    
        ' Add a sile and reference it
        Dim newSlide As Slide
        Set newSlide = ActivePresentation.Slides.AddSlide(ActivePresentation.Slides.Count + 1, pptLayout)
        
        ' Insert picture in new slide
        Dim newPicture As Shape
        Set newPicture = newSlide.Shapes.AddPicture(FileName:=selectedFile, _
                        LinkToFile:=msoCTrue, _
                        SaveWithDocument:=msoCTrue, _
                        Left:=60, _
                        Top:=35, _
                        Width:=98, _
                        Height:=48)
    Next selectedFile

End Sub

让我知道它是否有效

Answer 2

导入图像时，我还为空白幻灯片添加了一些内容 请看下文。再次非常感谢。

Public Sub InsertPicture()

    ' Declare and set a variable to ask for a file
    Dim fileDialogObject As FileDialog
    Set fileDialogObject = Application.FileDialog(msoFileDialogFilePicker)
    
    ' Adjust file dialog properties
    With fileDialogObject
        .InitialFileName = "C:\Temp"
        .Title = "Insert Picture"
        .ButtonName = "Insert picture"
        .InitialView = msoFileDialogViewDetails
        .Filters.Add "Images", "*.gif; *.jpg; *.jpeg,*.png,*.eps,*.tif,*.tiff", 1
    End With
    
    ' Show the file dialog to user and wait for response
    If fileDialogObject.Show = False Then Exit Sub
    
    ' Loop through each selected file (selectedFile returns the file path string)
    Dim selectedFile As Variant
    For Each selectedFile In fileDialogObject.SelectedItems
    
        ' Set new slide layout
        ' Dim pptLayout As CustomLayout
        ' Set pptLayout = ActivePresentation.Slides(1).CustomLayout
    
        ' Add a sile and reference it
        Dim newSlide As Slide
        Set newSlide = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutBlank)
        
        ' Insert picture in new slide
        Dim newPicture As Shape
        Set newPicture = newSlide.Shapes.AddPicture(FileName:=selectedFile, _
                        LinkToFile:=msoCTrue, _
                        SaveWithDocument:=msoCTrue, _
                        Left:=60, _
                        Top:=35, _
                        Width:=98, _
                        Height:=48)
    Next selectedFile

End Sub