Results 1 to 26 of 26

Thread: [RESOLVED] Power Point Profile

  1. #1

    Thread Starter
    Lively Member
    Join Date
    Apr 2006
    Posts
    109

    Resolved [RESOLVED] Power Point Profile

    Hello, I have a macro that can count Name:, File Size:, Number of Slide(s) Found:, Number of WordArt(s) found:, Number of TextBox found(s):, Number of Picture(s) found:, Number of AutoShape(s) found:, Number of Sound(s) & Video(s) file found:, Number of Diagram(s) found:, and Number of Chart(s) found: now what I want to do with this is when ever I press run, the macro will ask me to choose a folder that have all or some of my PowerPoint files saved then it will count all the stuff listed at top from each power point without any human interventions then it will ask me where I want to save as text file. Thanks A Lot
    Last edited by Kawser; Apr 18th, 2006 at 01:26 PM.

  2. #2
    Frenzied Member zaza's Avatar
    Join Date
    Apr 2001
    Location
    Borneo Rainforest Habits: Scratching
    Posts
    1,486

    Re: Power Point Profile

    Hi,

    You can use the filedialog object (in FolderPicker mode) to accomplish the navigation part. Check out the Excel Tips and Tricks link in my sig for some more info on this (it also applies to PowerPoint) or look it up in the VBA Help. There are plenty of examples there.

    You will also need to know how to write text files.


    zaza
    I use VB 6, VB.Net 2003 and Office 2010



    Code:
    Excel Graphing | Excel Timer | Excel Tips and Tricks | Add controls in Office | Data tables in Excel | Gaussian random number distribution (VB6/VBA,VB.Net) | Coordinates, Vectors and 3D volumes

  3. #3

    Thread Starter
    Lively Member
    Join Date
    Apr 2006
    Posts
    109

    Re: Power Point Profile

    Need More Help Please Thanks
    Last edited by Kawser; Apr 19th, 2006 at 11:40 AM.

  4. #4

    Thread Starter
    Lively Member
    Join Date
    Apr 2006
    Posts
    109

    Re: Power Point Profile

    How do I count the powerpoint item from the dialog box thanks.

  5. #5

    Thread Starter
    Lively Member
    Join Date
    Apr 2006
    Posts
    109

    Re: Power Point Profile

    PLEASE HELP THANKS (SAMPLE CODE) I know how to save it in a text file all I want to know is how to count all thoes stuff listed up with in multi folder thanks.

  6. #6
    Frenzied Member cssriraman's Avatar
    Join Date
    Jun 2005
    Posts
    1,465

    Re: Power Point Profile

    Hi,

    Here is the code usinge File dialog:
    VB Code:
    1. Sub ShowFileDialog()
    2.     Dim dlgOpen As FileDialog
    3.     Dim i As Long
    4.     Set dlgOpen = Application.FileDialog(Type:=msoFileDialogOpen)
    5.     With dlgOpen
    6.         .AllowMultiSelect = True
    7.         If .Show = -1 Then
    8.         'if the user press the Open button
    9.             .Execute
    10.         'Once the file is open then run your macros
    11.         '. . . . . . . . . . . . . . . .
    12.         '. . . . . . . . . . . . . . . .
    13.         '. . . . . . . . . . . . . . . .
    14.         'Now you close the presentation.
    15.             ActiveWindow.Close
    16.         End If
    17.     End With
    18. End Sub

    I hope this helps.

  7. #7
    Frenzied Member cssriraman's Avatar
    Join Date
    Jun 2005
    Posts
    1,465

    Re: Power Point Profile

    Here is another way to select all files in a given path:
    VB Code:
    1. Dim files() As String
    2.  
    3. Sub SelectAllPptFiles()
    4.     Dim i As Integer
    5.     Call GetFiles("c:\Temp\*.ppt")
    6.     For i = LBound(files) To UBound(files)
    7.         Debug.Print "C:\Temp\" & files(i)
    8.     Next i
    9. End Sub
    10.  
    11. Private Function GetFiles(ByVal dir_path As String) As String()
    12. ' Return an array containing the names of the
    13. ' files in the directory sorted alphabetically.
    14.     Dim num_files As Integer
    15.     Dim file_name As String
    16.     file_name = Dir$(dir_path)
    17.     Do While Len(file_name) > 0
    18.         ' See if we should skip this file.
    19.         If Not (file_name = ".") Or (file_name = "..") Then
    20.             num_files = num_files + 1
    21.             ReDim Preserve files(1 To num_files)
    22.             files(num_files) = file_name
    23.         End If
    24.         ' Get the next file.
    25.         file_name = Dir$()
    26.     Loop
    27. End Function

  8. #8

    Thread Starter
    Lively Member
    Join Date
    Apr 2006
    Posts
    109

    Smile Re: Power Point Profile

    I got it to work with ShowFileDialog but it does not save two or more ppt info at once on a singal text file it only does one, how do I make it so it will do more then one at once and also how do I close all the ppt when it's done. thanks a lot lot lot CSSRIRAMAN.
    Last edited by Kawser; Apr 20th, 2006 at 11:33 AM.

  9. #9
    Frenzied Member cssriraman's Avatar
    Join Date
    Jun 2005
    Posts
    1,465

    Re: Power Point Profile

    Here is the code to close all open presentations:
    VB Code:
    1. Sub ClosePPTs()
    2.     Dim PPT As Presentation
    3.  
    4.     For Each PPT In Presentations
    5.         PPT.Close
    6.     Next
    7.  
    8. End Sub

  10. #10

    Thread Starter
    Lively Member
    Join Date
    Apr 2006
    Posts
    109

    Re: Power Point Profile

    Thanks a lot man but when I save the text file only one gets saved not the others how do I do that thanks.

  11. #11
    Frenzied Member cssriraman's Avatar
    Join Date
    Jun 2005
    Posts
    1,465

    Re: Power Point Profile

    I hope this function will help you to add the required information to an exiting file:
    VB Code:
    1. Sub WriteTextFileContents(Text As String, filename As String, _
    2.                           Optional AppendMode As Boolean)
    3.     Dim fnum As Integer, isOpen As Boolean
    4.     On Error GoTo Error_Handler
    5.     ' Get the next free file number.
    6.     fnum = FreeFile()
    7.     If AppendMode Then
    8.         Open filename For Append As #fnum
    9.     Else
    10.         Open filename For Output As #fnum
    11.     End If
    12.     ' If execution flow gets here, the file has been opened correctly.
    13.     isOpen = True
    14.     ' Print to the file in one single operation.
    15.     Print #fnum, Text
    16.     ' Intentionally flow into the error handler to close the file.
    17. Error_Handler:
    18.     ' Raise the error (if any), but first close the file.
    19.     If isOpen Then Close #fnum
    20.     If Err Then Err.Raise Err.Number, , Err.Description
    21. End Sub

  12. #12

    Thread Starter
    Lively Member
    Join Date
    Apr 2006
    Posts
    109

    Re: Power Point Profile

    What I have right now to save the text file is

    VB Code:
    1. For Each Slide In ActivePresentation.Slides
    2. For Each Chart In Slide.Shapes
    3. If Chart.Type = msoChart Then
    4. ChartCounter = ChartCounter + 1
    5. End If
    6.  
    7. Next
    8.  
    9. Next
    10.  
    11. Data.CancelError = True
    12. On Error GoTo ErrHandler
    13.  
    14. Data.Filter = "Text File (*.txt)|*.txt| "
    15.  
    16. Data.ShowSave
    17. strFileName = Data.filename
    18.  
    19. Open strFileName For Output As #1
    20. Print #1, "Name:,File Size:,Number of Slide(s) Found:,Number of WordArt(s) found:,Number of TextBox found(s):,Number of Picture(s) found:,Number of AutoShape(s) found:,Number of Sound(s) & Video(s) file found:, Number of Diagram(s) found:,Number of Chart(s) found:"
    21. Print #1, PowerPoint.ActivePresentation.Name; ","; ActivePresentation.BuiltInDocumentProperties.Item("Number of Bytes") / 1000; "KB"; ","; ActivePresentation.Slides.Count; ","; WordArtCounter; ","; TextBoxCounter; ","; PictureCounter; ","; AutoShapeCounter; ","; SoundVideoCounter; ","; DiagramCounter; ","; ChartCounter
    22. Close #1
    23. Save.Caption = "File Opener - " & Data.FileTitle
    24.  
    25. End
    26.  
    27. ErrHandler:
    28.  
    29. End Sub

    Now how do I do it with this, and also close PPTs only close one PPT not all THANKS man you have helped me enough
    Last edited by Kawser; Apr 20th, 2006 at 02:08 PM.

  13. #13

    Thread Starter
    Lively Member
    Join Date
    Apr 2006
    Posts
    109

    Re: Power Point Profile

    The text thing is not working, and also PPTs close only close one PPT not all thanks.
    Last edited by Kawser; Apr 21st, 2006 at 12:49 PM.

  14. #14

    Thread Starter
    Lively Member
    Join Date
    Apr 2006
    Posts
    109

    Re: Power Point Profile

    Please Help Thanks

  15. #15

    Thread Starter
    Lively Member
    Join Date
    Apr 2006
    Posts
    109

    Re: Power Point Profile

    Keep in mind it's an VBA thanks.

  16. #16
    Frenzied Member cssriraman's Avatar
    Join Date
    Jun 2005
    Posts
    1,465

    Re: Power Point Profile

    Hi Kawser,

    Very sorry for delayed reply. Here is the solution:
    VB Code:
    1. Option Explicit
    2.  
    3. Sub WriteTextFileContents(strText As String, filename As String, Optional AppendMode As Boolean)
    4.     Dim fnum As Integer, isOpen As Boolean
    5.     On Error GoTo Error_Handler
    6.     ' Get the next free file number.
    7.     fnum = FreeFile()
    8.     If AppendMode Then
    9.         Open filename For Append As #fnum
    10.     Else
    11.         Open filename For Output As #fnum
    12.     End If
    13.     ' If execution flow gets here, the file has been opened correctly.
    14.     isOpen = True
    15.     ' Print to the file in one single operation.
    16.     Print #fnum, strText
    17.     ' Intentionally flow into the error handler to close the file.
    18. Error_Handler:
    19.     ' Raise the error (if any), but first close the file.
    20.     If isOpen Then Close #fnum
    21.     If Err Then Err.Raise Err.Number, , Err.Description
    22. End Sub
    23.  
    24. Sub HelpMe()
    25.     Dim dlgOpen As FileDialog
    26.     Dim strTxtFile As String
    27.     Dim iFile
    28.     strTxtFile = "C:\Temp\Testing.txt"
    29.     Set dlgOpen = Application.FileDialog(Type:=msoFileDialogOpen)
    30.     With dlgOpen
    31.         .AllowMultiSelect = True
    32.         If .Show = -1 Then
    33.             'if the user press the Open button
    34.             For Each iFile In .SelectedItems
    35.                 'To open the file
    36.                 Presentations.Open iFile
    37.  
    38.                 'Add the file Name
    39.                 Call WriteTextFileContents(iFile & vbCrLf, strTxtFile, True)
    40.  
    41.                 'Count the number of slides and store it in text file
    42.                 Call WriteTextFileContents("Total No. of Slides: " & Presentations(iFile).Slides.Count & vbCrLf, strTxtFile, True)
    43.  
    44.                 'To close the file
    45.                 Presentations(iFile).Close
    46.             Next
    47.         End If
    48.     End With
    49. End Sub
    Change the code as per your need.

    Regards,

  17. #17

    Thread Starter
    Lively Member
    Join Date
    Apr 2006
    Posts
    109

    Re: Power Point Profile

    Thanks a lot but it says path not found thanks again.

  18. #18
    Frenzied Member cssriraman's Avatar
    Join Date
    Jun 2005
    Posts
    1,465

    Re: Power Point Profile

    Here the text file name is "C:\Temp\Testing.txt". I think because of that you are getting that error. so make sure you have a folder called "Temp" in C drive.

    changed the code in my previous post in HelpMe procedure.

  19. #19

    Thread Starter
    Lively Member
    Join Date
    Apr 2006
    Posts
    109

    Re: Power Point Profile

    how do i make this automated please thanks.

  20. #20

    Thread Starter
    Lively Member
    Join Date
    Apr 2006
    Posts
    109

    Re: Power Point Profile

    also can you choose where do you want to save thanks

  21. #21
    Frenzied Member cssriraman's Avatar
    Join Date
    Jun 2005
    Posts
    1,465

    Re: Power Point Profile

    Quote Originally Posted by Kawser
    how do i make this automated please thanks.
    What do you want to automate?

    The code which I gave you will open the selected files one by one and count the number of slides and update the Testing.txt file.

    Whate else you want to do?

    You haven't mentioned anything about the Error you get last time. What happen to that? Are you still getting errors?

  22. #22

    Thread Starter
    Lively Member
    Join Date
    Apr 2006
    Posts
    109

    Re: Power Point Profile

    No I am not getting an erro but what I wanted was the user to select the ppt(s) that they want to test then choose where they want to save the text thanks a lot thoe.

  23. #23
    Frenzied Member cssriraman's Avatar
    Join Date
    Jun 2005
    Posts
    1,465

    Re: Power Point Profile

    Here is the complete code:
    VB Code:
    1. Option Explicit
    2.  
    3. Dim strFilter As String
    4. Dim strInputFileName As String
    5.  
    6. Type tagOPENFILENAME
    7.     lStructSize As Long
    8.     hwndOwner As Long
    9.     hInstance As Long
    10.     strFilter As String
    11.     strCustomFilter As String
    12.     nMaxCustFilter As Long
    13.     nFilterIndex As Long
    14.     strFile As String
    15.     nMaxFile As Long
    16.     strFileTitle As String
    17.     nMaxFileTitle As Long
    18.     strInitialDir As String
    19.     strTitle As String
    20.     Flags As Long
    21.     nFileOffset As Integer
    22.     nFileExtension As Integer
    23.     strDefExt As String
    24.     lCustData As Long
    25.     lpfnHook As Long
    26.     lpTemplateName As String
    27. End Type
    28.  
    29. Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean
    30.  
    31. Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean
    32. Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
    33.  
    34. Global Const ahtOFN_READONLY = &H1
    35. Global Const ahtOFN_OVERWRITEPROMPT = &H2
    36. Global Const ahtOFN_HIDEREADONLY = &H4
    37. Global Const ahtOFN_NOCHANGEDIR = &H8
    38. Global Const ahtOFN_SHOWHELP = &H10
    39. Global Const ahtOFN_NOVALIDATE = &H100
    40. Global Const ahtOFN_ALLOWMULTISELECT = &H200
    41. Global Const ahtOFN_EXTENSIONDIFFERENT = &H400
    42. Global Const ahtOFN_PATHMUSTEXIST = &H800
    43. Global Const ahtOFN_FILEMUSTEXIST = &H1000
    44. Global Const ahtOFN_CREATEPROMPT = &H2000
    45. Global Const ahtOFN_SHAREAWARE = &H4000
    46. Global Const ahtOFN_NOREADONLYRETURN = &H8000
    47. Global Const ahtOFN_NOTESTFILECREATE = &H10000
    48. Global Const ahtOFN_NONETWORKBUTTON = &H20000
    49. Global Const ahtOFN_NOLONGNAMES = &H40000
    50. Global Const ahtOFN_EXPLORER = &H80000
    51. Global Const ahtOFN_NODEREFERENCELINKS = &H100000
    52. Global Const ahtOFN_LONGNAMES = &H200000
    53.  
    54. Function TestIt()
    55.     Dim strFilter As String
    56.     strFilter = ahtAddFilterItem(strFilter, "Text Files (*.txt)", "*.TXT")
    57.     strFilter = ahtAddFilterItem(strFilter, "All Files (*.*)", "*.*")
    58.     Call HelpMe
    59. End Function
    60.  
    61. Function ahtCommonFileOpenSave(Optional ByRef Flags As Variant, Optional ByVal InitialDir As Variant, Optional ByVal Filter As Variant, Optional ByVal FilterIndex As Variant, Optional ByVal DefaultExt As Variant, Optional ByVal filename As Variant, Optional ByVal DialogTitle As Variant, Optional ByVal hwnd As Variant, Optional ByVal OpenFile As Variant) As Variant
    62.     Dim OFN As tagOPENFILENAME
    63.     Dim strFileName As String
    64.     Dim strFileTitle As String
    65.     Dim fResult As Boolean
    66.     If IsMissing(InitialDir) Then InitialDir = CurDir
    67.     If IsMissing(Filter) Then Filter = ""
    68.     If IsMissing(FilterIndex) Then FilterIndex = 1
    69.     If IsMissing(Flags) Then Flags = 0&
    70.     If IsMissing(DefaultExt) Then DefaultExt = ""
    71.     If IsMissing(filename) Then filename = ""
    72.     If IsMissing(DialogTitle) Then DialogTitle = ""
    73.     If IsMissing(OpenFile) Then OpenFile = True
    74.     strFileName = Left(filename & String(256, 0), 256)
    75.     strFileTitle = String(256, 0)
    76.     With OFN
    77.         .lStructSize = Len(OFN)
    78.         .strFilter = Filter
    79.         .nFilterIndex = FilterIndex
    80.         .strFile = strFileName
    81.         .nMaxFile = Len(strFileName)
    82.         .strFileTitle = strFileTitle
    83.         .nMaxFileTitle = Len(strFileTitle)
    84.         .strTitle = DialogTitle
    85.         .Flags = Flags
    86.         .strDefExt = DefaultExt
    87.         .strInitialDir = InitialDir
    88.         .hInstance = 0
    89.         .lpfnHook = 0
    90.         .strCustomFilter = String(255, 0)
    91.         .nMaxCustFilter = 255
    92.     End With
    93.     If OpenFile Then
    94.         fResult = aht_apiGetOpenFileName(OFN)
    95.     Else
    96.         fResult = aht_apiGetSaveFileName(OFN)
    97.     End If
    98.     If fResult Then
    99.         If Not IsMissing(Flags) Then Flags = OFN.Flags
    100.         ahtCommonFileOpenSave = TrimNull(OFN.strFile)
    101.     Else
    102.         ahtCommonFileOpenSave = vbNullString
    103.     End If
    104. End Function
    105.  
    106. Function ahtAddFilterItem(strFilter As String, strDescription As String, Optional varItem As Variant) As String
    107.     If IsMissing(varItem) Then varItem = "*.*"
    108.     ahtAddFilterItem = strFilter & strDescription & vbNullChar & varItem & vbNullChar
    109. End Function
    110.  
    111. Private Function TrimNull(ByVal strItem As String) As String
    112.     Dim intPos As Integer
    113.     intPos = InStr(strItem, vbNullChar)
    114.     If intPos > 0 Then
    115.         TrimNull = Left(strItem, intPos - 1)
    116.     Else
    117.         TrimNull = strItem
    118.     End If
    119. End Function
    120.  
    121. Sub WriteTextFileContents(strText As String, filename As String, Optional AppendMode As Boolean)
    122.     Dim fnum As Integer, isOpen As Boolean
    123.     On Error GoTo Error_Handler
    124.     ' Get the next free file number.
    125.     fnum = FreeFile()
    126.     If AppendMode Then
    127.         Open filename For Append As #fnum
    128.     Else
    129.         Open filename For Output As #fnum
    130.     End If
    131.     ' If execution flow gets here, the file has been opened correctly.
    132.     isOpen = True
    133.     ' Print to the file in one single operation.
    134.     Print #fnum, strText
    135.     ' Intentionally flow into the error handler to close the file.
    136. Error_Handler:
    137.     ' Raise the error (if any), but first close the file.
    138.     If isOpen Then Close #fnum
    139.     If Err Then Err.Raise Err.Number, , Err.Description
    140. End Sub
    141.  
    142. Sub HelpMe()
    143.     Dim lngFlags As Long
    144.     Dim dlgOpen As FileDialog
    145.     Dim strTxtFile As String
    146.     Dim iFile
    147.     Set dlgOpen = Application.FileDialog(Type:=msoFileDialogOpen)
    148.     strTxtFile = ahtCommonFileOpenSave(InitialDir:="C:\", Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, DialogTitle:="Save the Txt file As")
    149.     With dlgOpen
    150.         .AllowMultiSelect = True
    151.         If .Show = -1 Then
    152.             'if the user press the Open button
    153.             For Each iFile In .SelectedItems
    154.                 'To open the file
    155.                 Presentations.Open iFile
    156.  
    157.                 'Add the file Name
    158.                 Call WriteTextFileContents(iFile & vbCrLf, strTxtFile, True)
    159.  
    160.                 'Count the number of slides and store it in text file
    161.                 Call WriteTextFileContents("Total No. of Slides: " & Presentations(iFile).Slides.Count & vbCrLf, strTxtFile, True)
    162.  
    163.                 'To close the file
    164.                 Presentations(iFile).Close
    165.             Next
    166.         End If
    167.     End With
    168. End Sub

  24. #24
    Frenzied Member cssriraman's Avatar
    Join Date
    Jun 2005
    Posts
    1,465

    Re: Power Point Profile

    Run the function "TestIT". first it will ask you to save the text file and then it will ask you to select the ppt files then it will process.

  25. #25
    Frenzied Member cssriraman's Avatar
    Join Date
    Jun 2005
    Posts
    1,465

    Re: Power Point Profile

    Do you need any other help on this thread?

    When you have received an answer to your question, please mark it as resolved using the Thread Tools menu.

  26. #26

    Thread Starter
    Lively Member
    Join Date
    Apr 2006
    Posts
    109

    Re: Power Point Profile

    Thanks A Lot cssriraman that looks complicated your the great.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width