Question

对于学校我正在创建大量的PowerPoint演示文稿，其中包含图片（数百到数千），以便创建像经验一样的“闪卡”。我编写了一个代码，用于从目录中导入照片，并将图片分别插入到连续幻灯片中，文本框中幻灯片底部的图片名称。到目前为止，我没有遇到任何问题。但是，我想创建一个索引页面，按顺序列出所有文件名，但在演示文稿开头的文本框中有一个单独的行。

我只包含了我的代码的相关部分。

' (2a)Adds Index Page, compiles file names into index page as a list
' Creates slide
Set oSld = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutBlank)

With Application.ActivePresentation.PageSetup
    .SlideHeight = 612
    .SlideWidth = 1087
End With

' Create Title Box with Specified Dimensions and Slide Position
Set oPic = oSld.Shapes.AddShape(Type:=msoShapeRectangle, _
           Left:=40, Top:=36, Width:=1007, Height:=540)


' FORMAT TEXTBOX SHAPE

' Shape Name
oPic.Name = "Index"

' No Shape Border
oPic.Line.Visible = msoFalse

' Shape Fill Color
oPic.Fill.ForeColor.RGB = RGB(255, 255, 255)

' Shape Text Color
oPic.TextFrame.TextRange.Font.Color.RGB = RGB(1, 0, 0)

' Left Align Text
oPic.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignLeft

' Vertically Align Text to Top
oPic.TextFrame2.VerticalAnchor = msoAnchorTop

' Adjust Font Size
oPic.TextFrame2.TextRange.Font.Size = 11

' Adjust Font Style
oPic.TextFrame2.TextRange.Font.Name = "Arial"

' Change file path to desired directory and add "\" TO THE END:
strPath = "C:\Users\josephandrews\Desktop\Test\" '*****N.B. note the last "\" at end of line
strFileSpec = "*.jpg" 'you can change the selected file format, (e.g. "*.png") but only one file type can be used

strTemp = Dir(strPath & strFileSpec)

' Text inside Shape. Important to note that strTemp is the pic file name
oPic.TextFrame.TextRange.Characters.Text = strTemp & vbNewLine

' Required paramater for Loop through pictures
Do While strTemp <> ""
    ' Causes search for next picture in directory
    strTemp = Dir
Loop

我希望这能够在文本框中创建所有文件名的列表。

之后只显示第一个带有新行的文件的名称。

Answer 1

找到答案。这是我的例子。

Sub Test_2()

' Demonstrates the use of DIR to return a file at a time

Dim strPath As String
Dim strFile As String
Dim strFileSpec As String
Dim strFilesFound As String
Dim oSld As Slide
Dim oTbox As Shape

strPath = "C:\Users\BobComputer\Desktop\Test\" ' or wherever you want to look for files
strFileSpec = "*.jpg" ' or whatever type of files you want to list

' get the first file that meets our specification
strFile = Dir$(strPath & strFileSpec)

' if we got at least one file, continue:
While strFile <> ""
    strFilesFound = strFilesFound & strFile & vbCrLf
    ' get the next file and loop
    strFile = Dir
Wend

' let's see what we've got
'MsgBox strFilesFound
 Set oSld = ActivePresentation.Slides(2)
 Set oTbox = oSld.Shapes(1)
    oTbox.TextFrame.TextRange.Characters.Text = strFilesFound


End Sub

从目录中将文件名提取到文本框Powerpoint VBA中

1 个答案: