TPE

http://bayanbox.ir/view/263405954590585756/2mobile.png

Tavvafi@gmail.com


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

همانطور که در بدنه اصلی شرح نرم افزار حفاظت از فایل های پاورپوینت توضیح داده شد،کاربرد کدهای ماکرو گاهی به منظور استفاده از آنها هنگام اجرا و نمایش پاورپوینت است، 

گاهی نیز به منظور سازماندهی سریعتر بر اساس منطقی خاص است که در این بخش به این نوع برنامه نویسی خواهیم پرداخت.

Sub MakeLotsOfLinks()

Dim TheTextBox As Shape
Dim FileName As String
Dim LinkRange As TextRange
Dim Top, Left, width, height As Double
Dim targetFileSpec As String

' EDIT THIS:  Replace the text between the equals signs
'                     with the path to the folder where your PPT files are stored
targetFileSpec = "D:\Test\*.PPT"

' Rather arbitrary starting positions for text box
Top = 18#
Left = 18#
width = 600#
height = 30#

' Get the first matching file
FileName = Dir$(targetFileSpec)

' And if somebody's home:
While FileName <> ""

    ' Add a textbox to hold the link
    Set TheTextBox =
ActiveWindow.Selection.SlideRange.Shapes.AddTextbox(msoTextOrientationHorizontal, _
        Left, _
        Top, _
        width, _
        height)

    TheTextBox.TextFrame.TextRange.Text = FileName

    Set LinkRange = TheTextBox.TextFrame.TextRange.Characters(Start:=1, Length:=Len(FileName))
    LinkRange.ActionSettings(ppMouseClick).Hyperlink.Address = FileName

    ' Get the next file
    FileName = Dir$
    ' move the text box start position down
    Top = Top + height
Wend

End Sub

اگر ترجیح می دهید حدولی از لینکها داشته باشید، می توانید از کد زیر استفاده کنید.

ابتدا یک جدول با سلول های شماره دار که می خواهید نام فایل ها و لینک آنها در آن باشد بسازید، بعد جدول را انتخاب کنید و کد زیر را اجرا کنید.

Sub MakeLotsOfLinksInATable()

Dim FileName As String
Dim LinkRange As TextRange
Dim targetFileSpec As String

Dim aFileNames() As String
Dim oTable As Shape
Dim x As Long
Dim y As Long
Dim lPointer As Long

' EDIT THIS:  Replace the text between the equals signs
'                     with the path to the folder where your PPT files are stored
targetFileSpec = "c:\myfiles\*.PPT"

ReDim aFileNames(1 To 1) As String

' Fill the array with filenames
FileName = Dir$(targetFileSpec)

' And if files are found:
While FileName <> ""
    aFileNames(UBound(aFileNames)) = FileName
    FileName = Dir$
    ReDim Preserve aFileNames(1 To UBound(aFileNames) + 1) As String
Wend
' that leaves us with blank array entry; remove it:
ReDim Preserve aFileNames(1 To UBound(aFileNames) - 1) As String

' now use the table
Set oTable = ActiveWindow.Selection.ShapeRange(1)
lPointer = 1

For y = 1 To oTable.Table.Rows.Count
    For x = 1 To oTable.Table.Columns.Count
        oTable.Table.Cell(y, x).Shape.TextFrame.TextRange.Text = aFileNames(lPointer)
        Set LinkRange = _
          oTable.Table.Cell(y, x).Shape.TextFrame.TextRange.Characters(Start:=1, Length:=Len(aFileNames(lPointer)))
        LinkRange.ActionSettings(ppMouseClick).Hyperlink.Address = aFileNames(lPointer)
        lPointer = lPointer + 1
    Next    ' x
Next    ' y

End Sub