如何使用VBA将excel单元格中的图像插入powerpoint?

How to insert an image from an excel cell into powerpoint using VBA?

提问人:user22857676 提问时间:11/4/2023 最后编辑:user22857676 更新时间:11/5/2023 访问量:73

问:

幻灯片输出 1 个文本 + 1 个图片,2 个文本 + 1 个图片我想再介绍 3 个文本占位符,总计到 4.My 图片位于 excelsheet 的第 4 列中。但是当我引入第二个 TextPlaceholder 时,图片不在图片占位符中。所以,我把代码修改为

Sld.Shapes.Placeholders(1).TextFrame.TextRange.Text = DataRow.Cells(1, 1)
            Sld.Shapes.Placeholders(2).TextFrame.TextRange.Text = DataRow.Cells(1, 2)
            Sld.Shapes.Placeholders(3).TextFrame.TextRange.Text = DataRow.Cells(1, 3)
                        
            sCell = DataRow.Cells(1, 4).Address
            ' Check if there is a shp in Column 3
            If objDic.exists(sCell) Then
                objDic(sCell).Copy
                Sld.Shapes.Placeholders(4).Select
                Sld.Shapes.PasteSpecial DataType:=ppPasteMetafilePicture
            End If

即使有 4 个文本占位符,输出也是相同的。图片不在 PicturePlaceholder 中。 试了好几次。无法弄清楚我哪里出了问题?我能得到帮助吗?

前 2 行在文本框中包含图像,接下来的两行作为没有文本框的图像插入单元格我有一张包含三列 A、B 和 C 的 excelsheet。第一列有两列文本,第三列 C 在文本框中嵌入了图像。我有 1000 多行。我想将这些列导出到 PPT 幻灯片。我在PPT的幻灯片中有三个占位符。前两个占位符用于插入文本,第三个占位符用于插入图像。我编写了一个 vba 宏,用于将第一列的文本从 excel 导出到 ppt。我想知道如何从Excel工作表的第三列(图像在文本框中)插入图像的第三个占位符。 程序如下。

Sub LoopRowsSelected2Choices()
    Dim DataRange As Range
    Dim DataRow As Range
    Dim AppPPT As PowerPoint.Application
    Dim Prs As PowerPoint.Presentation
    Dim Sld As PowerPoint.Slide
    Set AppPPT = GetObject(, "PowerPoint.Application")
    Set Pres = AppPPT.ActivePresentation
    Set DataRange = Selection
    For Each DataRow In DataRange.Rows
        
        Set Sld = Pres.Slides.AddSlide(Pres.Slides.Count + 1, Pres.SlideMaster.CustomLayouts(2))
        Sld.Shapes.Placeholders(1).TextFrame.TextRange.Text = DataRow.Cells(1, 1)
        Sld.Shapes.Placeholders(2).TextFrame.TextRange.Text = DataRow.Cells(1, 2)
     Next DataRow
End Sub

前两列的占位符工作正常。我在第三列中有图像,并希望在 ppt 中的第三个占位符中用于图片。有什么解决办法吗? 提前致谢

我尝试并成功插入文本,但没有插入图像。对 VBA 相当陌生。

Excel VBA 图像 导出 PowerPoint

评论

0赞 taller 11/5/2023
TextBox 用于保存文本。请显示有关“嵌入在文本框中的图像”的屏幕截图。
0赞 user22857676 11/5/2023
你是对的。实际上,我首先尝试将图像插入单元格中。由于我做不到,我将其插入文本框并尝试使用文本框的属性,无论如何它都有效。我无法在此评论中附上屏幕截图。如果我能够从没有文本框的单元格中提取图像,那就太好了。谢谢你追求这个。
0赞 taller 11/5/2023
如果您编辑您的帖子(而不是评论),您可以上传图像。

答:

1赞 taller 11/5/2023 #1

细胞上的图片是一个很好的方法。使用VBA代码更容易操作。

Option Explicit

Sub LoopRows()
    Dim DataRange As Range
    Dim DataRow As Range
    Dim AppPPT As PowerPoint.Application
    Dim Pres As PowerPoint.Presentation
    Dim Sld As PowerPoint.Slide
    Dim objDic As Object, Shp As Shape, i As Integer
    Dim sCell As String
    Set AppPPT = GetObject(, "PowerPoint.Application")
    Set Pres = AppPPT.ActivePresentation
    ' Verify the Selection is a Range object
    If TypeName(Selection) = "Range" Then
        ' Load Dict, Key = TopLeftCell.Address, Value = Shp object
        Set objDic = CreateObject("scripting.dictionary")
        For i = 1 To ActiveSheet.Shapes.Count
            Set Shp = ActiveSheet.Shapes(i)
            If Not Application.Intersect(Shp.TopLeftCell, Selection) Is Nothing Then
                Set objDic(Shp.TopLeftCell.Address) = Shp
            End If
        Next
        Set DataRange = Selection
        ' Loop through data row
        For Each DataRow In DataRange.Rows
            Set Sld = Pres.Slides.AddSlide(Pres.Slides.Count + 1, Pres.SlideMaster.CustomLayouts(2))
            Sld.Select
            Sld.Shapes.Placeholders(1).TextFrame.TextRange.Text = DataRow.Cells(1, 1)
            Sld.Shapes.Placeholders(2).TextFrame.TextRange.Text = DataRow.Cells(1, 2)
            sCell = DataRow.Cells(1, 3).Address
            ' Check if there is a shp in Column 3
            If objDic.exists(sCell) Then
                objDic(sCell).Copy
                Sld.Shapes.Placeholders(3).Select
                Sld.Shapes.PasteSpecial DataType:=ppPasteMetafilePicture
            End If
        Next DataRow
    End If
End Sub

Microsoft 文档:

Shapes.PasteSpecial 方法 (PowerPoint)

enter image description here

评论

0赞 user22857676 11/5/2023
效果很好。完全如我所愿。再次感谢。