在 powerpoint 中查看图片（在 ms 访问中存储为附件）答案

【问题标题】：view picture(stored as attachment in ms access) in powerpoint在 powerpoint 中查看图片（在 ms 访问中存储为附件）
【发布时间】：2021-03-04 17:44:54
【问题描述】：

我正在尝试在 PowerPoint 演示文稿中展示我的 MS 访问数据。我正在编写一个 VBA 代码以根据我的数据创建一个 ppt。我想在每张幻灯片中找到一张圆形裁剪照片。这些照片在 MS Access 中保存为附件。

• 此代码是用在我的桌面上找到的照片填充椭圆形，效果很好：

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

-结果如下：

• 但我需要从数据库中挑选这些图片，所以我使用了这段代码，但它给了我“UserPicture 对象的 Fillformat 失败”：

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

End With

其中“照片”是表中存储附件的字段

完整代码：

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

【问题讨论】：

您是在 access 还是 PowerPoint 中运行代码？你能edit你的问题并提供完整的代码吗？
是的，当然！我在访问中运行代码
可能必须先将图像提取到文件夹位置，然后从文件夹中将图像拉入 PP。
也许显示图像是如何存储在数据库中的。您可以发布表格结构的打印件吗？解决方案背后的逻辑是让图像可以从您可以参考的文件路径访问 ppt。
非常感谢！！它奏效了

标签： vba ms-access powerpoint

【解决方案1】：

假定图像必须从文件夹位置加载到 PP。以编程方式从 Access 表附件字段中提取图像是一个常见主题，并且有许多示例可用。保存到磁盘然后在 PP 中加载可能是这样的：

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")
...

【讨论】：