vba 宏将图像文件名加载到幻灯片而不是图像
vba macros load image file name into slide & not the image
我是新来的,希望得到你的帮助。
我有一个适用于 PowerPoint 的宏加载项,在旧版本上运行良好。
新的365办公室没有运行;通过一些技巧,我能够解决大部分问题。
现在唯一剩下的就是当尝试打开文件夹中的 select 图像文件时,它会将图像名称加载到每张幻灯片并且 而不是 图像!
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
如果有效请告诉我
我刚刚在导入图像时还为空白幻灯片添加了一些内容
请看下面。再次非常感谢。
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
我是新来的,希望得到你的帮助。 我有一个适用于 PowerPoint 的宏加载项,在旧版本上运行良好。 新的365办公室没有运行;通过一些技巧,我能够解决大部分问题。 现在唯一剩下的就是当尝试打开文件夹中的 select 图像文件时,它会将图像名称加载到每张幻灯片并且 而不是 图像!
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
如果有效请告诉我
我刚刚在导入图像时还为空白幻灯片添加了一些内容 请看下面。再次非常感谢。
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