У меня есть макрос на основе VBA для PPT, который вставляет файлы JPEG в отдельные слайды (см. «Макрос 1» ниже). Мой вопрос:
【Мой вопрос】
Я хочу добавить следующую функцию в 【Макрос 1】;
Автоматически вставлять имя файла вставленного изображения в каждый слайд.
Я попытался вставить имя файла, используя «ActiveWindow.Selection.SlideRange.Name» и т. Д. c., Но макрос, кажется, останавливается, если такое описание вставлено.
【Макрос 1】
Вы можете загрузить оригинальную версию этого макроса с здесь . Этот макрос является модифицированной версией макроса Ref1. Связанный макрос может автоматически вставлять изображения в слайды без ошибок, , но он не может использовать имя изображения в качестве имени слайда .
（изменено в 2020/03/29 JST）
Макрос на Box1 ниже является одним из прототипов макросов, которые были созданы при попытке добавить нужные функции в вышеупомянутый макрос. Я изменил на основе совета в ответе, но я получаю ошибку времени выполнения. Я пробовал добавлять разные места, но результат один и тот же.
（изменено в 2020/03/31 JST） Вот завершенная версия: этот макрос успешно отвечает моим требованиям, описанным в «Мой вопрос». Следующее (ref2) было очень полезно при создании этого макроса. Вы можете загрузить эту версию макроса из здесь
[Box1] (изменено в 2020/03/31 JST)
Sub InsertImages()
'Insert all image files from the same level folder
Dim prs As PowerPoint.Presentation
Dim sld As PowerPoint.Slide
Dim shp As PowerPoint.Shape
Dim txt As PowerPoint.Shape
Dim tmp As PowerPoint.PpViewType
Dim fol As Object, f As Object
Dim fol_path As String
'Store open presentation in prs
Set prs = ActivePresentation
'Cancel if slide show mode
If SlideShowWindows.Count > 0 Then prs.SlideShowWindow.View.Exit
With ActiveWindow
tmp = .ViewType 'Remember window display mode
.ViewType = ppViewSlide
End With
'Get the path of the folder where this ppt file are.
fol_path = ActivePresentation.Path
'Processing files in the folders
With CreateObject("Scripting.FileSystemObject")
If Not .FolderExists(fol_path) Then GoTo Fin
For Each f In .GetFolder(fol_path).Files
'Process only JPEG files
Select Case LCase(.GetExtensionName(f.Path))
Case "jpg", "jpeg"
'Add slids
Set sld = prs.Slides.Add(prs.Slides.Count + 1, ppLayoutChartAndText)
sld.Select
'Insert image
Set shp = sld.Shapes.AddPicture(FileName:=f.Path, _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=0, _
Top:=0)
With shp
.LockAspectRatio = True 'Fix the aspect ratio
'Fit inserted image to slide size
If .Width > .Height Then
.Width = prs.PageSetup.SlideWidth
Else
.Height = prs.PageSetup.SlideHeight
End If
.Select
'Resize image
.Width = .Width * 0.85
.Height = .Height * 0.85
End With
'Center image on slide
With ActiveWindow.Selection.ShapeRange
.Align msoAlignCenters, True
.Align msoAlignMiddles, True
End With
'Change slide title to file name
sld.Shapes(1).TextFrame.TextRange.Text = f.Name
'Insert Text
'Set txt = sld.Shapes.AddTextbox( _
'Orientation:=msoTextOrientationHorizontal, _
'Left:=600, _
'Top:=50, _
'Width:=250, _
'Height:=10)
' With txt
' .Name = "AddedTextBox"
' .TextFrame.TextRange = "free text"
' .TextEffect.FontSize = 20
' End With
End Select
Next
End With
Fin:
ActiveWindow.ViewType = tmp 'Restore window display mode
End Sub
【 Ссылки る
(ссылка 1) PowerPoint 10 ク ロ , написано на японском языке.
(ссылка 2) ワ ン ン BA BA BA BA BA BA BA BA BA BA BA BA BA BA BA BA BA BA BA BA BA BA BA BA BA BA BA , написано на японском языке.