كيفية قراءة الخطوط من ملف نصي واحد تلو الآخر مع رمز Power Point VBA؟

StackOverflow https://stackoverflow.com/questions/1719342

سؤال

سيقوم هذا الرمز بقراءة خط من ملف نصي:

set file = CreateObject("Scripting.FileSystemObject").OpenTextFile("c:\number.txt", 1)
text = file.ReadLine
MsgBox text

كيف يمكنني أن أقرأها سطر واحد مرارا وتكرارا بعد آخر من نفس الملف؟ أعتقد، يجب أن أستخدم حلقة هنا، أليس كذلك؟ أحتاج إليها لقراءة السطر الأول من الملف في التكرار الأول، والسطر الثاني في التكرار الثاني، والثالث في الثالث وما إلى ذلك حتى يتم قراءة جميع الخطوط. كيف يمكنني فعل ذلك؟

إضافة مهمة: أحتاج إلى رمز العمل على كل سطر واحد من قبل واحد - وليس كل مرة واحدة!

هل كانت مفيدة؟

المحلول

استخدم ال ReadAll() طريقة:

text = file.ReadAll

(قد تكون ذات أهمية: ملف filesystemobject عينة رمز)

مع حلقة:

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, MyFile, FileName, TextLine

Set fso = CreateObject("Scripting.FileSystemObject")

FileName = "c:\testfile.txt"

Set MyFile = fso.OpenTextFile(FileName, ForReading)

'' Read from the file
Do While MyFile.AtEndOfStream <> True
    TextLine = MyFile.ReadLine

    '' Do stuff to TextLine

Loop
MyFile.Close

نصائح أخرى

إذا كنت ترغب في استخدام روتينات معالجة ملفات VBA المضمنة، فستستخدم رمز مثل هذا:

Sub ReadAFileLineByLine()
    Dim InStream As Integer
    InStream = FreeFile()
    Open "C:/tmp/fastsynchtoquesttry_quest.txt" For Input As InStream

    Dim CurrLine As String
    Do While True
        Line Input #InStream, CurrLine
        ' do stuff to CurrLine
        If EOF(InStream) Then Exit Do
    Loop

    Close #InStream
End Sub

يمكنك إضافة مرجع * إلى نموذج كائن Windows Script المضيف، وسوف يساعدك في كائن FileSystemObject، لأنه يمكنك أن تقول:

Dim fs As FileSystemObject
Dim f As TextStream

والذي سيسمح لك باستخدام Intellisense لرؤية الخصائص المختلفة ومتصفح الكائنات لاستكشاف المكتبة.

* في إطار التعليمات البرمجية، اختر الأدوات والمراجع ووضع علامة في المربع بجانب المكتبة التي تريدها.

كتبت روتين VBA الذي يقرأ ملف نصي وإدراج شريحة جديدة لكل جملة في النص.

أولا، في الشريحة # 1، إضافة زر يستدعي الماكرو المسمى "توليد"

يذهب شفرة المصدر:

Const DEFAULT_SLIDE = 1 ' the slide to copy the layout style from
Const MARGIN = 50       ' margin of the generated textbox

Sub generate()
    Dim txtFile As String   ' text file name
    Dim fileNo As Integer   ' file handle
    Dim buffer As String    ' temporary string buffer
    Dim sentence() As String    ' the main array to save sentences
    Dim i, total As Integer
    Dim myLayout As CustomLayout
    Dim mySlide As Slide
    Dim myShape As Shape
    Dim myWidth, myHeight As Integer    'slide width and height


    txtFile = "text2sample.txt"
    txtFile = ActivePresentation.Path & "\" & txtFile   'textfile should be in the same Dir as this ppt

    If Len(Dir$(txtFile)) = 0 Then
        MsgBox txtFile & " file not found."
        Exit Sub
    End If

    'Initialize array
    ReDim sentence(0)

    'get file handle number
    fileNo = FreeFile()
    Open txtFile For Input As #fileNo

    i = 0
    Do While Not EOF(fileNo)
        Line Input #fileNo, buffer  'read & save sentences line by line
        ReDim Preserve sentence(i + 1)  ' increase 1 more array
        sentence(i) = LTrim(RTrim(buffer))
        i = i + 1
    Loop
    Close #fileNo

    total = i
    Randomize   ' for random color

    With ActivePresentation.PageSetup
        myWidth = .SlideWidth - MARGIN  'get width and height
        myHeight = .SlideHeight - MARGIN
    End With

    For i = 0 To total
        Set myLayout = ActivePresentation.Slides(DEFAULT_SLIDE).CustomLayout
        'add a slide like slide #1
        Set mySlide = ActivePresentation.Slides.AddSlide(DEFAULT_SLIDE + 1 + i, myLayout)
        'add a textbox with margin
        Set myShape = ActivePresentation.Slides(DEFAULT_SLIDE + 1 + i).Shapes. _
        AddTextbox(msoTextOrientationHorizontal, MARGIN, MARGIN, myWidth, myHeight)
        With myShape
            'add a sentence
            .TextFrame.TextRange.Text = sentence(i)
            .TextFrame.TextRange.Font.Size = 60
            ' color 255 is too bright. Pick a less bright color (200)
            .TextFrame.TextRange.Font.Color.RGB = RGB(Int(Rnd * 200), Int(Rnd * 200), Int(Rnd * 200))
            .TextFrame.TextRange.Font.Bold = msoTrue
            .TextFrame.TextRange.Font.Shadow = msoTrue
            ' If you want to change the color of the shape
            '.Fill.ForeColor.RGB = RGB(Int(Rnd * 200), Int(Rnd * 200), Int(Rnd * 200))
            '.Fill.BackColor.RGB = RGB(Int(Rnd * 200), Int(Rnd * 200), Int(Rnd * 200))
            '.Fill.Solid
        End With
        'add a textbox for slideshow progress ex) 1/100
        Set myShape = ActivePresentation.Slides(DEFAULT_SLIDE + 1 + i).Shapes. _
        AddTextbox(msoTextOrientationHorizontal, 0, 0, 150, 20)
        With myShape
            .TextFrame.TextRange.Text = "( " & i & " /" & total & " )"
            .TextFrame.TextRange.Font.Size = 20
            .TextFrame.TextRange.Font.Color.RGB = RGB(100, 100, 100)
        End With
    Next

    MsgBox total & " Slides were added.", vbInformation

End Sub

تحميل الملف:http://konahn.tistory.com/attachment/cfile8.uf@2175154c573d3bc02a2dfa.pptm.

مرخصة بموجب: CC-BY-SA مع الإسناد
لا تنتمي إلى StackOverflow
scroll top