vba - vba 宏将图像文件名加载到幻灯片而不是图像中
问题描述
我是新来的,希望您能提供帮助。我有一个用于 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
解决方案
关于您的代码的一些说明:
- 你错过了这个
GetOpenFileName
功能。 - 打开文件对话框并返回文件路径现在很简单。无需读取和缓冲图片文件
请阅读代码的注释并根据您的需要进行调整
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
让我知道它是否有效
推荐阅读
- c# - c#数据表到csv导出
- three.js - Three.js - 有没有一种简单的方法来处理片段着色器中的纹理并使用 GPUComputationRenderer 将其返回到 JavaScript 代码中?
- powershell - FFMPEG 输出帧数在音频文件 PowerShell 上不同
- node.js - 区分 MongoDB find() 中丢失的文档
- javascript - 如何在jquery的while循环中调用click函数?
- python - 为什么yum install python3 install python3.6
- tabs - 管理选项卡上的 magento 2 客户侧边栏删除时事通讯
- python - 单击图像后 Pygame 不显示所需的输出
- java - 如何将浮动操作按钮带到 Android 应用程序之外?
- python - 连续变量和整数的乘积