CODEWITHSUNDEEP
vbams-accesspowerpoint
zahraa
zahraa

Reputation: 94

view picture(stored as attachment in ms access) in powerpoint

I'm trying to present my MS access data in a PowerPoint presentation. I'm writing a VBA code in access to create a ppt based on my data. I want to locate a circle cropped photo in each slide. These photos are saved as attachments in MS access.

• this code is to fill the oval shape with a photo found on my Desktop and it worked perfectly:

With .Shapes.AddShape(msoShapeOval, 360, 121, 220, 220) 
     .Fill _
     .UserPicture "C:\Users\USER\Desktop\kkk.jpg"
     .Line.Visible = False   'no outline
End With

-Here's the result: enter image description here

• but I need to these pics to be picked from database, so I used this code but it gives me "UserPicture of object Fillformat failed":

With .Shapes.AddShape(msoShapeOval, 360, 121, 220, 220) 
     .Fill _
     .UserPicture (CStr(rs.Fields("photo").Value.FileName))
     .Line.Visible = False   'no outline

End With

complete code:

Option Compare Database

Option Explicit

Sub cmdPowerPoint_Click()
    Dim db As Database, rs As Recordset
    Dim ppObj As PowerPoint.Application
    Dim ppPres As PowerPoint.Presentation

    On Error GoTo err_cmdOLEPowerPoint

    ' Open up a recordset on the Employees table.
    Set db = CurrentDb
    Set rs = db.OpenRecordset("Employees", dbOpenDynaset)
    
    ' 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.
    With ppPres
        While Not rs.EOF
            With .Slides.Add(rs.AbsolutePosition + 1, ppLayoutTitle)
                .Shapes(1).TextFrame.TextRange.Text = "Hi!  Page " & rs.AbsolutePosition + 1
                .SlideShowTransition.EntryEffect = ppEffectFade
                With .Shapes(2).TextFrame.TextRange
                    .Text = CStr(rs.Fields("LastName").Value)
                    .Characters.Font.Color.RGB = RGB(255, 0, 255)
                    .Characters.Font.Shadow = True
                End With
                With .Shapes.AddShape(msoShapeOval, 360, 121, 220, 220) 'photo
                     .Fill _
                     .UserPicture (CStr(rs.Fields("photo").Value.FileName))
      
                    .Line.Visible = False   'no outline

                End With
                
                With .Shapes.AddShape(msoShapeOval, 85, 260, 85, 85) 'customer
                     .Fill.ForeColor.RGB = RGB(239, 48, 120)
                     .Line.Visible = False

                End With

                With .Shapes.AddShape(msoShapeOval, 85, 355, 135, 135) 'improvement (down)
                     .Fill.ForeColor.RGB = RGB(0, 176, 240)
                     .Line.Visible = False

                End With



               With .Shapes.AddShape(msoShapeOval, 38, 136, 110, 110) 'staff
                    .Fill.ForeColor.RGB = RGB(238, 149, 36)
                    .Line.Visible = False

               End With

               With .Shapes.AddShape(msoShapeOval, 158, 45, 135, 135) 'improvement (up)
                    .Fill.ForeColor.RGB = RGB(0, 176, 240)
                    .Line.Visible = False

               End With

                With .Shapes.AddShape(msoShapeOval, 193, 206, 135, 135) 'characteristics
                     .Fill.ForeColor.RGB = RGB(238, 149, 36)
                     .Line.Visible = False
                End With
                
                .Shapes(1).TextFrame.TextRange.Characters.Font.Size = 50
            End With
            rs.MoveNext
        Wend
    End With

    ' Run the show.
    ppPres.SlideShowSettings.Run

    Exit Sub

err_cmdOLEPowerPoint:
    MsgBox Err.Number & " " & Err.Description
End Sub

Upvotes: 1

Views: 207

Answers (1)

June7
June7

Reputation: 21370

Presume images must be loaded to PP from a folder location. Programmatically extracting image from Access table attachment field is a common topic and many examples are available. Saving to disk and then loading in PP could be like:

Dim rs As DAO.Recordset, fd As DAO.Field2
Set rs = CurrentDb.OpenRecordset("Employees", dbOpenDynaset)
...
Set fd = rs("photo")
fd("FileData").SaveToFile CurrentProject.path
.Fill.UserPicture CurrentProject.path & "\" & fd("FileName")
Kill CurrentProject.path & "\" & fd("FileName")
...

Upvotes: 1

Related Questions