TPE
Tavvafi@gmail.com |
≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡
در تکه کد زیر مسیر فایل سند پاورپوینت به عنوان مسیر ذخیره سازی یک فایل متنی استخراج می شود.
متن عنوان اسلاید نیز دریافت شده و نهایتا در فایل متنی ذخیره می شود.
البته جزئیات بیشتری نیز وجود دارد که مربوط به کنترل خطا و ارائه پیامهای مناسب درصورت بروز خطا و نیز کنترل رشته های متنی است.
Sub GatherTitles() On Error GoTo ErrorHandler Dim oSlide As Slide Dim strTitles As String Dim strFilename As String Dim intFileNum As Integer Dim PathSep as String If ActivePresentation.Path = "" Then MsgBox "Please save the presentation then try again" Exit Sub End If #If Mac Then PathSep = ":" #Else PathSep = "\" #End If On Error Resume Next ' in case there's no title placeholder on the slide For Each oSlide In ActiveWindow.Presentation.Slides strTitles = strTitles _ & "Slide: " _ & CStr(oSlide.SlideIndex) & vbCrLf _ & oSlide.Shapes.Title.TextFrame.TextRange.Text _ & vbCrLf & vbCrLf Next oSlide On Error GoTo ErrorHandler intFileNum = FreeFile ' PC-Centricity Alert! ' This assumes that the file has a .PPT extension and strips it off to make the text file name. strFilename = ActivePresentation.Path _ & PathSep _ & Mid$(ActivePresentation.Name, 1, Len(ActivePresentation.Name) - 4) _ & "_Titles.TXT" Open strFilename For Output As intFileNum Print #intFileNum, strTitles NormalExit: Close intFileNum Exit Sub ErrorHandler: MsgBox Err.Description Resume NormalExit End Sub