دانلود و استفاده کنيد، در صورت رضايت از عملکرد نرم افزار، کد فعالسازي تهيه کنيد.

contact دانلود و استفاده کنيد
تغییر نام تمام Shapeها در پرزنتیشن، به اسامی منحصر به فرد

TPE

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

Tavvafi@gmail.com


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

Sub RenameAllShapes()
' Renames all shapes in a presentation to prevent problems with
' duplicate shape names

    Dim oSl As Slide
    Dim osh As Shape
    Dim sTemp As String
    Dim lCtr As Long
    Dim sFlagString As String
    Dim sAddMe As String

    ' The strategy is:
    ' Create a flag string ... this'll be a rotating selection of one of three
    ' strings, !RnmA, !RnmB or !RnmC
    ' The previously-used flag is stored in a presentation level tag

    ' Get the previously-used flag, choose a new flag based on the result:
    sFlagString = ActivePresentation.Tags("RenameAllShapes")
    Select Case UCase(sFlagString)
        Case Is = ""
            sFlagString = "!RnmA"
        Case Is = "!RNMA"
            sFlagString = "!RnmB"
        Case Is = "!RNMB"
            sFlagString = "!RnmC"
        Case Is = "!RNMC"
            sFlagString = "!RnmA"
        Case Else
            sFlagString = "!RnmA"
    End Select
    Debug.Print sFlagString

    ' save the new flag back to the presentation tag
    ActivePresentation.Tags.Add "RenameAllShapes", sFlagString

    ' look at each shape on each slide
    lCtr = 1

    For Each oSl In ActivePresentation.Slides
        For Each osh In oSl.Shapes

            ' create a unique string to add to the end of the name
            ' Looks like !RnmA-xxxxx where xxxxx is a unique sequential number
            ' derived from the lCtr counter
            ' MUST always be the same number of digits so we can strip it later
            ' allowing for 10,000 shapes should do it
            sAddMe = " " & sFlagString & "-" & Format(lCtr, "00000")

            ' has the shape already been renamed?  if so, extract original name
            If InStr(osh.Name, "!Rnm") > 0 Then
                sTemp = Left$(osh.Name, Len(osh.Name) - Len(sAddMe))
            ' or just use the name as it is
            Else
                sTemp = osh.Name
            End If

            ' tack the AddMe string onto the end of the shape name
            sTemp = sTemp & sAddMe
            osh.Name = sTemp
            lCtr = lCtr + 1
        Next
    Next

End Sub


powerpoint

پاورپوینت

پاورپوینت powerpoint

نمايش متن DOS تبديل متن DOS تبديل متن Win تبديل متن Excel ارسال پيامک انبوه مديريت زمان تحليل نمرات کارنامه اينترنتي کارنامه ماهانه
TA TC TA TXLSx TSMS TLC TANALIZE MKTREE MAHKAR

رفع مشکلات Access با نصب AccessRuntime

حلال Database Unrecognized Format در Access 2007

حفاظت از کدهاي برنامه نويسي شده در محيط VBA-Access

تغيير تصوير بک گراند صفحه ورود به Windows 7

بروزآوري آيکن هاي ويندوز Refresh Desktop Icons

dll شماره سريال چاپ فرم ارزشيابي حفاظت از PDFها حفاظت از فيلم ها حفاظت پاورپوينت
TSN Asessment TDE TVE TPE