Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

vba access to add notes to ppt 2

Status
Not open for further replies.
aldi07

aldi07

MIS
Jun 22, 2010
100
0
0
CA
Hi,
I am using the following vba access to transfer pictures from access to powerpoint:

While Not rs.EOF
MySource = rs![Photo_Path_And_Name].Value
MyDestination = "D:\Photos\DataMiningResult\Slide" & Trim(Str(I)) & ".jpg"
FileCopy MySource, MyDestination
OldFileName = MyDestination
NewFileName = "D:\Photos\DataMiningResult\Slide" & rs![Photo_Date] & "_" & Trim(Str(I)) & ".jpg"
Name MyDestination As NewFileName
I = I + 1
rs.MoveNext
Wend

It works well. But I would like to complete the powerpoint, by adding some informations from access into the powerpoint notes for each slide. Is there a way to do it?

Thank you in advance.
 
Sort by date Sort by votes
Actually, you do not 'transfer pictures from access to powerpoint', you simply copy files from one location to another and rename the files.

But, if you want to 'add some informations from access into the powerpoint notes' you can Record the Macro in PowerPoint, write a note, and look at the code created in your Macro.
Then, in Access, you can reference the PowerPoint, and use the code created in your macro :)

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson
 
Upvote 0 Downvote
Hi Andrzejek,
You are quite right. I posted the wrong code. Sorry about that. It should have been:
' Setup the set of slides and populate them with data from the
' set of records.
I = 1
rs.MoveFirst
With ppPres
While Not rs.EOF
FilePathAndName = "D:\Photos\DataMiningResult\Slide" & rs![Photo_Date] & "_" & Trim(Str(I)) & ".jpg"
With .Slides.ADD(rs.AbsolutePosition + 1, ppLayoutTitle)
' If rs!Photo_Type = "Portrait" Then
.Shapes(1).DELETE
.Shapes(1).DELETE
With .Shapes.AddPicture( _
FileName:=FilePathAndName, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, Left:=0, Top:=0, _
Width:=-1, Height:=-1)
End With
.SlideShowTransition.EntryEffect = ppEffectFade
I = I + 1
End With
rs.MoveNext
Wend
 
Upvote 0 Downvote
You may be able to shorten your code to just:

Code: 
While Not rs.EOF
    MySource = rs![Photo_Path_And_Name].Value[green]
    'MyDestination = "D:\Photos\DataMiningResult\Slide" & Trim(Str(I)) & ".jpg"[/green]
    MyDestination = [blue]"D:\Photos\DataMiningResult\Slide" & rs![Photo_Date] & "_" & Trim(Str(I)) & ".jpg"[/blue]
    FileCopy MySource, MyDestination[green]
    'OldFileName = MyDestination
    'NewFileName = "D:\Photos\DataMiningResult\Slide" & rs![Photo_Date] & "_" & Trim(Str(I)) & ".jpg"
    'Name MyDestination As NewFileName[/green]
    I = I + 1
    rs.MoveNext
Wend

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson
 
Upvote 0 Downvote
2 points:
1 - Could you format your code as CODE so it could be readable? (see my previous post)
2 - What code do you get from the recorded macro when you add a Note to your slide?


---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson
 
Upvote 0 Downvote
Unfortunately you cannot record a macro in VBA PowerPoint 365. See the explanation below, from Internet:
Can you record a macro in PowerPoint 365?
Microsoft PowerPoint doesn't ship a macro recorder such as the one you'll find in Word or Excel. Therefore, if you want to automate PowerPoint, you'll need to create your macro manually using Visual Basic for applications (VBA).

I'll try to find an older version of PowerPoint and record a macro...
 
Upvote 0 Downvote
Hi Andy,
Thank you for your answer. I finally figured it out by myself, since PowerPoint has no macro recorder. This works very well, and allows me to put any text in my PowerPoint notes:
Code: 
            While Not rs.EOF
                FilePathAndName = "D:\Photos\DataMiningResult\Slide" & rs![Photo_Date] & "_" & Trim(Str(I)) & ".jpg"
                With .Slides.ADD(rs.AbsolutePosition + 1, ppLayoutTitle)
                    .Shapes(1).DELETE
                    .Shapes(1).DELETE
                    With .Shapes.AddPicture( _
                            FileName:=FilePathAndName, _
                            LinkToFile:=msoFalse, _
                            SaveWithDocument:=msoTrue, Left:=0, Top:=0, _
                            Width:=-1, Height:=-1)
                    End With
                    .SlideShowTransition.EntryEffect = ppEffectFade
                '******************************************************************************************************************************************
                'Add relevant text to Notes
                '******************************************************************************************************************************************
                ppObj.ActivePresentation.Slides(I).NotesPage.Shapes(2).TextFrame.TextRange.Text = "Test for my photos" & " Slide No " & I
                '******************************************************************************************************************************************
                  I = I + 1
                End With
                rs.MoveNext
            Wend
P.S.
1- I did not understand fully your code which is shorter than mine. It gives me the following error:
Slides (unknown member) ; integer out of range. 1 is not in the valid range of 1 to 0.
2- As you can see, I was able to use the "code" format to make my code more easily readable! [dazed]
 
Upvote 0 Downvote
Actually, I did not figured it completely by myself. I did some research on the internet that helped me figure out the right statement... [bigglasses]
 
Upvote 0 Downvote
Just curious...
If you have 25 records in your rs, you actually do:[tt]
.Shapes(1).DELETE[/tt]
twice for every record... [ponder]

And [tt]With[/tt] statement is used when you refer to the same object more than once, so I would do:
Code: 
...
[s]With[/s] .Shapes.AddPicture( _
        FileName:=FilePathAndName, _
        LinkToFile:=msoFalse, _
        SaveWithDocument:=msoTrue, Left:=0, Top:=0, _
        Width:=-1, Height:=-1)
[s]End With[/s]
...

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson
 
Upvote 0 Downvote
Hi Andy,
1- You are right about .Shapes(1).DELETE. Once is enough! [dazed]

2-
...
Code: 
[s]With[/s] .Shapes.AddPicture( _
        FileName:=FilePathAndName, _
        LinkToFile:=msoFalse, _
        SaveWithDocument:=msoTrue, Left:=0, Top:=0, _
        Width:=-1, Height:=-1)
[s]End With[/s]
...
will not work. I have to enclose the code between "With / End With", otherwise I get a syntax error (see picture attached)

3- About your code where you stipulate earlier in that thread: You may be able to shorten your code, you were right. I didn't do it properly before. It works fine with your code.

Thank you.

Alex
 
 https://files.engineering.com/getfile.aspx?folder=ceffc013-1ad2-45a5-bf31-8bdf70f63434&file=code.jpg
Upvote 0 Downvote
You had a syntax error because, in my opinion, you mix which Property you are referencing with the '[tt]With ... End With[/tt]' statements. And inside this structure, you reference different Property of your object.
And I believe you start with '[tt]With ppPres[/tt]', but later you reference '[tt]ppObj.ActivePresentation.Slides...[/tt]'
Very confusing, IMO

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson
 
Upvote 0 Downvote
Try without parentheses and without With ... End With:
[pre] .Shapes(1).Delete
.Shapes.AddPicture FileName:=FilePathAndName, LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, Left:=0, Top:=0, Width:=-1, Height:=-1[/pre]

Does your VBA editor keep ADD and DELETE in capitals?

combo
 
Upvote 0 Downvote
Yes. With the code you just provided, it works. Just a question of brackets... The syntax could be tricky sometimes.

Answering your question concerning pPres and ppObj, here is how I use them:

Set ppObj = New PowerPoint.Application
Set ppPres = ppObj.Presentations.ADD
 
Upvote 0 Downvote
In essence he has, I'm guessing here:

Code: 
I = 1
rs.MoveFirst[blue]
With ppPres[/blue]
    While Not rs.EOF
        FilePathAndName = "D:\Photos\DataMiningResult\Slide" & rs![Photo_Date] & "_" & Trim(Str(I)) & ".jpg"
   [s]With[/s] .Slides.ADD(rs.AbsolutePosition + 1, ppLayoutTitle)[green]
        'Shouldn't this be simply:[/green][red]
        .Slides.ADD(I, ppLayoutTitle)   '???[/red]
        .Shapes(1).DELETE
        [s].Shapes(1).DELETE[/s]
        .Shapes.AddPicture FileName:=FilePathAndName, LinkToFile:=msoFalse, _
            SaveWithDocument:=msoTrue, Left:=0, Top:=0, Width:=-1, Height:=-1 
        .SlideShowTransition.EntryEffect = ppEffectFade
        I = I + 1
        rs.MoveNext
    Wend [green]'rs[/green][blue]
End With[/blue] [green]'ppPres[/green]

And all of the other '[tt]With ... End With[/tt]' just mess it up.

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson
 
Upvote 0 Downvote
Here you can see the difference of MsgBox syntax when it returns or not value. The case with AddPicture above is similar.

combo
 
Upvote 0 Downvote
Andy:
Actually my code is much longer, and I didn't want to bother you with it.
Here is a little bit more if it can make more sense of the different "end with" and "Wend":

Code: 
....
    ElseIf Me.frmORppt = "ppt" Then
        ' Open up an instance of Powerpoint.
        Set ppObj = New PowerPoint.Application
        Set ppPres = ppObj.Presentations.ADD
        
        ' Setup the set of slides and populate them with data from the
        ' set of records.
        I = 1
        rs.MoveFirst
        Dim MyProvState As String
        MyProvState = rs![ProvinceStateDescription]
        
        '************************************************************************************************************************************************************************
        'Fill tblAllPersonsByPhotoForPptNotes from qryAllPersonsByPhotoForPptNotes_App to add the persons names to the PowerPoint Notes
        '************************************************************************************************************************************************************************
        DoCmd.SetWarnings False
            DoCmd.OpenQuery "qryAllPersonsByPhotoForPptNotes_Del"
            DoCmd.OpenQuery "qryAllPersonsByPhotoForPptNotes_App"
        DoCmd.SetWarnings True
        Set rs5 = db.OpenRecordset("tblAllPersonsByPhotoForPptNotes", dbOpenDynaset)
        '************************************************************************************************************************************************************************

        With ppPres
            While Not rs.EOF
                FilePathAndName = "D:\Photos\DataMiningResult\Slide" & rs![Photo_Date] & "_" & Trim(Str(I)) & ".jpg"
                If MyProvState = "Unknown" Then
                    MyProvState = ""
                End If
                With .Slides.ADD(rs.AbsolutePosition + 1, ppLayoutTitle)
                    .Shapes(1).DELETE
                    .Shapes.AddPicture _
                    FileName:=FilePathAndName, _
                    LinkToFile:=msoFalse, _
                        SaveWithDocument:=msoTrue, Left:=0, Top:=0, Width:=-1, Height:=-1
                    .SlideShowTransition.EntryEffect = ppEffectFade
                
                    '************************************************************************************************************************************************************************
                    ' Add the persons names to the variable MyNames
                    '************************************************************************************************************************************************************************
                    Dim MyPhoto_ID As Integer
                    Dim MyNames As Variant
                    MyNames = ""
                    rs5.MoveFirst
                    MyPhoto_ID = rs![Photo_ID]
                    While Not rs5.EOF
                        Select Case MyPhoto_ID
                        Case rs5![Photo_ID]
                               MyNames = MyNames & "Last Name: " & rs5![Person_LastName] & _
                            "             First Name: " & rs5![Person_FirstName] & _
                            "              " & rs5![Person_Comment] & vbCrLf
                        End Select
                        rs5.MoveNext
                    Wend
                    '************************************************************************************************************************************************************************
                    'Add relevant text to PowerPoint Notes
                    '************************************************************************************************************************************************************************
                    ppObj.ActivePresentation.Slides(I).NotesPage.Shapes(2).TextFrame.TextRange.Text = "Photo ID: " & rs![Photo_ID] & vbCrLf & _
                        "Date Photo: " & rs![Photo_Date] & vbCrLf & _
                        "Commentaire Photo: " & rs![Photo_Comment] & vbCrLf & _
                        "Pays: " & rs![Country] & vbCrLf & _
                        "Ville: " & rs![City] & vbCrLf & _
                        "Rue ou Lieu: " & rs![Location_Street] & vbCrLf & _
                        "Province ou Etat: " & MyProvState & vbCrLf & _
                        "Code Postal: " & rs![Location_Postal_Code] & vbCrLf & _
                        "Commentaire Lieu: " & rs![Location_Comment] & vbCrLf & _
                        MyNames
                    '************************************************************************************************************************************************************************
                
                    I = I + 1
                End With
                rs.MoveNext
            Wend
            rs.Close
            rs5.Close
            db.Close
        
            MyMonth = Str(Month(Now()))
            If Len(Trim(MyMonth)) < 2 Then MyMonth = Trim("0" & Trim(MyMonth))
            MyDay = Str(Day(Now()))
            If Len(Trim(MyDay)) < 2 Then MyDay = Trim("0" & Trim(MyDay))
            MyHour = Str(Hour(Now()))
            If Len(Trim(MyHour)) < 2 Then MyHour = Trim("0" & Trim(MyHour))
            MyMinute = Str(Minute(Now()))
            If Len(Trim(MyMinute)) < 2 Then MyMinute = Trim("0" & Trim(MyMinute))
            MySecond = Str(Second(Now()))
            If Len(Trim(MySecond)) < 2 Then MySecond = Trim("0" & Trim(MySecond))
            MyDate = Trim(Year(Now()) & Trim(MyMonth) & Trim(MyDay) & " " & Trim(MyHour) & Trim(MyMinute) & Trim(MySecond))
            MyExtension = ".ppt"
            MyFileName = "D:\Photos\DataMiningResult\AllMyPhotos" & MyDate
            .SaveAs MyFileName, ppSaveAsPresentation
        End With
        Me.MyFileName = MyFileName
        Beep
        MsgBox "Done"
End If

Exit_CalcDataMiningResult:
    Exit Sub

Err_CalcDataMiningResult:
    MsgBox Err.Description
    Resume Exit_CalcDataMiningResult
    
End Sub

However, if you really want to see the whole code, I don't mind displaying it with some explanations of what I am achieving. Just let me know.

combo: I noticed I left your following quetion unanswered:
<<Does your VBA editor keep ADD and DELETE in capitals?>>
Yes, it does actually.
 
Upvote 0 Downvote
Thank you for the explanation.
But all those date manipulations: MyMonth, MyDay, MyHour, etc. Why?
Just to have 2 digit month, day, hour, etc? Why not simply:
[tt]
Debug.Print Format(Now, "mm/dd/yyyy hh:nn:ss AM/PM")
01/31/2022 07:14:48 AM
[/tt]

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson
 
Upvote 0 Downvote
I use the date as part of the powerpoint file name I am saving. If more than one file are saved at the same minute. The seconds would then differentiate them.
I am not sure I can use the debug.print statement to include the result as part of the saved file name.
 
Upvote 0 Downvote
[tt]Debug.Print[/tt] was just an example of how you can Format Date and Time to what you need, without all those [tt]
If Len(Trim(MyMonth)) < 2 Then MyMonth = Trim("0" & Trim(MyMonth))[/tt]

Code: 
[s]MySecond = Str(Second(Now()))
If Len(Trim(MySecond)) < 2 Then MySecond = Trim("0" & Trim(MySecond))
MyDate = Trim(Year(Now()) & Trim(MyMonth) & Trim(MyDay) & " " & Trim(MyHour) & Trim(MyMinute) & Trim(MySecond))
MyExtension = ".ppt"
[/s]MyFileName = "D:\Photos\DataMiningResult\AllMyPhotos" [blue]& Format(Now, "mm/dd/yyyy hh:nn:ss AM/PM") &[/blue] ".ppt"
.SaveAs MyFileName, ppSaveAsPresentation

Just a suggestion....[pc1]

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Moss100
  • Question
Filter vba problem
Replies
0
Views
86
Moss100
Moss100
Omarahmed22
  • Locked
  • Question
VBA Formating
Replies
1
Views
97
Andrzejek
Andrzejek
Moss100
  • Locked
  • Question
Add multiple contacts to outlook - from access table
Replies
12
Views
138
Moss100
Moss100
Moss100
  • Locked
  • Question
Vba adding record to table when field is integer
Replies
8
Views
135
Moss100
Moss100
Knicks
  • Locked
  • Question
Microsoft Access VBA Coding to Excel (early binding) 1
Replies
2
Views
141
Knicks
Knicks

Part and Inventory Search

Sponsor

Back
Top