TPE

Tavvafi@gmail.com

≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡

این ماکرو اطلاعات را از فایلی در مسیر "c:\folder\filename.txt" دریافت می کند.

فایل باید چیزی شبیه به این باشد:

Heading1
Text that's to appear under heading 1
Heading2
Text that's to appear under heading 2
Heading3
And so on

سپس این اطلاعات را در پاورپوینت به اسلاید تبدیل می کند.

Sub HeadingsAndTextFromFile()

' Purpose:
' Read a plain text file like this:

'Heading1
'Text that's to appear under heading 1
'Heading2
'Text that's to appear under heading 2
'Heading3
'And so on

' And convert it to a presentation with one slide per Heading in the file

Dim sFileName As String
Dim iFileNum As Integer
Dim sHeading As String
Dim sText As String
Dim oSl As Slide

If Presentations.Count = 0 Then
    MsgBox "Open a presentation then try again"
    Exit Sub
End If

' EDIT THIS TO REFLECT THE NAME AND LOCATION
' OF THE TEXT FILE YOU WANT TO USE:
sFileName = "c:\folder\filename.txt"

iFileNum = FreeFile()
Open sFileName For Input As iFileNum

' Use the current presentation
With ActivePresentation
    Do While Not EOF(iFileNum)
        Line Input #iFileNum, sHeading
        Line Input #iFileNum, sText
        Set oSl = .Slides.Add(.Slides.Count + 1, ppLayoutText)
        With oSl
            ' Relying on shape names is a bit risky but since we've
            ' just created the slide, the defaults should be safe:
            .Shapes("Rectangle 2").TextFrame.TextRange.Text = sHeading
            .Shapes("Rectangle 3").TextFrame.TextRange.Text = sText
        End With
    Loop
End With

Set oSl = Nothing
Close iFileNum

End Sub