폴더에서 여러 그림을 삽 입합니다. 이 프로그램은 폴더의 맨 위에서 시작하여 내림차순으로 그림을 삽입해야하지만 그렇지 않습니다.폴더에서 여러 그림을 내림차순으로 삽입하십시오.
첫 번째 3-5 장의 그림은 프레젠테이션의 마지막 부분이며 다른 모든 부분은 완벽한 순서입니다. 다음 그들 방법 주문 :
Sub createTransModel()
Dim oSlide As Slide
Dim oPicture As Shape
Dim myFile As String
Dim myFolder As String
Dim pptLayout As CustomLayout
Dim fileName As String
Dim rotSlide As Slide
Set pptLayout = ActivePresentation.Slides(1).CustomLayout
myFolder = GetFolderPath()
myFile = Dir(myFolder & "*.png")
Do While myFile <> ""
Set oSlide = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, _
ppLayoutBlank)
Set oPicture = oSlide.Shapes.AddPicture(myFile, _
msoFalse, msoTrue, 1, 1, _
ActivePresentation.PageSetup.SlideWidth, _
ActivePresentation.PageSetup.SlideHeight)
myFile = Dir
Loop
fileName = inputBox("Please enter the filename")
ActivePresentation.SaveAs (fileName & ".pps")
End Sub
Public Function GetFolderPath() As String
Dim myFile As Object
Dim fileSelected As String
Dim path As String
Dim objPPT As Object
Dim i As Integer
Dim folderFromPath As String
Dim directory As String
directory = "M:\tm\public\Conti_Anlage\Voith Proben"
Set myFile = Application.FileDialog(msoFileDialogOpen)
With myFile
.InitialFileName = directory
.Title = "Choose File"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Function
End If
fileSelected = .SelectedItems(1)
End With
For i = Len(fileSelected) To 1 Step -1
If Mid(fileSelected, i, 1) = "\" Then
folderFromPath = Left(fileSelected, i)
Exit For
End If
Next
GetFolderPath = folderFromPath
End Function
파일 대화 상자에서 사용되는 Windows 탐색기가 스와핑 (너무 많은 해결 방법으로 인해 더 이상 수정할 수없는 오래된 버그)하기 때문에 사용자가 선택한 첫 번째와 마지막 항목이 바뀌었을 수 있습니다. 이 경우 목록의 첫 번째 항목과 마지막 항목을 바꿔 넣기 만하면됩니다. – Christoph
나는 그 버그도 가지고 있었지만, 이미 그것을 고쳤다. 그것의 코드에 게시되지 않았지만. 그 버그는 그 파일과는 독립적 인 것 같습니다. – Christian
아니, 네가 여기 있는게 네 문제가 아니야. 파일을 수동으로 반복하고 파일 대화 상자에서 여러 개를 선택하지 마라. – Christoph