PowerPoint Automation

[stringman]

Hello. I am trying to automate a PP presentation. The slides are populated by images that exist in a directory. I have been struggling to format one of the images all day and have hit the proverbial brick wall. I am using Access 2003 to generate this code.

The problem is w/ the following code:

            .Shapes(3).Fill.Transparency = 0#
            .Shapes(3).Line.Weight = "3"
            .Shapes(3).Line.Style = msoLineThinThin
            .Shapes(3).Line.ForeColor.SchemeColor = ppForeground
            .Shapes(3).Line.BackColor.RGB = RGB(255, 255, 255)

The shape I am tyring to format is the 3rd shape created. If I count the shapes, I get a total of 4, which is correct, but when I reference the shape for formatting, nothing happens. No error message either. The manual equivalent is to right click on the image, Select "Format Picture" and change properties w/in the "Colors and Lines" tab. Here is the entire function:

Private Sub cmdBuildPP_Click()
  Dim varItem As Variant        'name of current file w/ full path
  Dim strPath As String
  Dim strPathAndFile As String
  Dim strFileName As String
  Dim aTemp() As String
  Dim aFiles() As String
  Dim iCounter As Integer
  Dim strStartDir As String
  Dim ppObj As PowerPoint.Application
  Dim ppPres As PowerPoint.Presentation
  Dim strSite As String
  Dim strStats As String
  Dim strVector As String
  Dim varShape As Variant
  
  strFileName = ""
  strStartDir = "X:\Validation\Special_Projects\PFI_Study\Charts\PowerPoints\" & strDirName
  
  With Application.FileSearch
    .NewSearch
    .LookIn = strStartDir
    .FileName = "*.*"
    .SearchSubFolders = True
    .Execute
  
    i = 0
    
    For Each varItem In .FoundFiles
      strPathAndFile = varItem
      Call GetFileName(aTemp, strPathAndFile, strFileName)
      ReDim Preserve aFiles(i)
      aFiles(i) = strPathAndFile
      i = i + 1
    Next
  End With
    
    ' Open up an instance of Powerpoint.
    Set ppObj = New PowerPoint.Application
    Set ppPres = ppObj.Presentations.Add
    iCounter = UBound(aFiles)
    j = 0
    
    ppPres.Application.Visible = msoCTrue
    With ppPres
      For i = 0 To iCounter - 1
        j = j + 1
        aTemp = Split(aFiles(i), "\")
        iCounter = UBound(aTemp)
        strFileName = aTemp(iCounter)
        strSite = Left(strFileName, 5)
        strStats = Mid(strFileName, 7, 5)
        strVector = Mid(strFileName, 7, 6)
        With .Slides.Add(j, ppLayoutTitleOnly)
    
          .Shapes(1).TextFrame.TextRange.Text = strSite & ": " & strDirToProcess
          .Shapes(1).Left = "36"
          .Shapes(1).Top = "72"
          .Shapes(1).Width = "648"
          .Shapes(1).TextFrame.TextRange.Font.Size = "36"
          .Shapes(1).Height = "51"
          If strStats = "Stats" Then
            .Shapes().AddPicture aFiles(i), msoFalse, msoCTrue, 36, 150                   'Stats image
            .Shapes().AddPicture aFiles(i + 1), msoFalse, msoCTrue, 350, 150                'Vector plot
            .Shapes().AddPicture strBaseDir & "5m_Scale.jpg", msoFalse, msoTrue, 100, 350 'Scale image for vector plot
             'This is were the problem is!  The formatting commands do not take
            .Shapes(3).Fill.Transparency = 0#
            .Shapes(3).Line.Weight = "3"
            .Shapes(3).Line.Style = msoLineThinThin
            .Shapes(3).Line.ForeColor.SchemeColor = ppForeground
            .Shapes(3).Line.BackColor.RGB = RGB(255, 255, 255)
            i = i + 1
          Else
            MsgBox "Vector or Stats Image not Found", vbCritical, "ERROR"
          End If
        End With
      Next i
    End With
    
    ppPres.SaveCopyAs (strSaveAs)
    ppPres.SlideShowSettings.Run
    
End Sub

Any help would be greatly appreciated. Thanks in advance.

Ken

 

[stringman]

Any thoughts on this? Maybe what I'm asking is not clear? Any help would be greatly appreciated.

Ken

 

[Access Hero]

It is very difficult to follow your code because of the PHP Code tag you used. That is probably why nobody looked at it before.

My guess is that you need to read the help file on UBound and reconsider whether you really want your For loop to go only to UBound - 1.

[COLOR=#000000][COLOR=Black]    iCounter [/COLOR][COLOR=Black]= [/COLOR][COLOR=Black]UBound[/COLOR][COLOR=Black]([/COLOR][COLOR=Black]aFiles[/COLOR][COLOR=Black]) 'Should return 3, in your scenario.
    [/COLOR][COLOR=Black]j [/COLOR][COLOR=Black]= [/COLOR][COLOR=Black]0 
     
    ppPres[/COLOR][COLOR=Black].[/COLOR][COLOR=Black]Application[/COLOR][COLOR=Black].[/COLOR][COLOR=Black]Visible [/COLOR][COLOR=Black]= [/COLOR][COLOR=Black]msoCTrue 
    With ppPres 
      [/COLOR][COLOR=Black]For [/COLOR][COLOR=Black]i [/COLOR][COLOR=Black]= [/COLOR][COLOR=Black]0 To iCounter [/COLOR][COLOR=Black]- [/COLOR][COLOR=#0000bb][COLOR=Black]1 'If UBound returned 3 before, your loop will go from 0 to 2, which would only include 3 objects.

HTH
[/COLOR]
[/COLOR][/COLOR]