文章/答案/技术大牛

发布

社区首页 >问答首页 >VBA:基于Excel的单元格值在PowerPoint文件夹中插入图片

问VBA:基于Excel的单元格值在PowerPoint文件夹中插入图片
EN

Stack Overflow用户

提问于 2022-11-02 08:48:30

回答 2查看 28关注 0票数 0

我花了很多时间试图写一个VBA代码来自动化我的工作，但是我不知道怎么写。我希望这里有人能帮我。

目标是根据Excel中的值将图片从文件夹中插入到PowerPoint的表中。

我的设备上的文件夹中有5不同图片(.png)。Excel中的单元格值从1到5。

根据单元格值的不同，我希望在Powerpoint的表格中插入这5幅图片中的一幅。

例如:如果excel-value =2，则在powerpoint中插入picture2。

我希望以上这些都是有意义的，我希望有人能帮助我。

我尝试了以下几点：

Sub ESG_Globes()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    ' Define PPT objects
    Dim oPPT            As PowerPoint.Presentation
    Dim appPPT          As PowerPoint.Application
    Dim oWS             As Excel.Worksheet
    Dim fileNameString  As String
    Dim boolUploadToIntranet As Boolean
    Dim cells As Range
    Dim s14 As Integer, s15 As Integer, s13 As Integer
    Dim ESG1, ESG2, ESG3, ESG4, ESG5 As String
    Dim ImageBox, ImageBox2 As PowerPoint.Shape



With oPPT.Slides(8)
            For k = 4 To 22
'Globes PNG Location
ESG1 = "S:\S8RENTE\Credit & Equity Research\ESG\Grafik\Glober (PNG)\SustainabilityRating_Low.png"
ESG2 = "S:\S8RENTE\Credit & Equity Research\ESG\Grafik\Glober (PNG)\SustainabilityRating_BelowAverage.png"
ESG3 = "S:\S8RENTE\Credit & Equity Research\ESG\Grafik\Glober (PNG)\SustainabilityRating_Average.png"
ESG4 = "S:\S8RENTE\Credit & Equity Research\ESG\Grafik\Glober (PNG)\SustainabilityRating_AboveAverage.png"
ESG5 = "S:\S8RENTE\Credit & Equity Research\ESG\Grafik\Glober (PNG)\SustainabilityRating_High.png"
    
    ' Check if file is open - if not, open it
    fOpen = IsFileOpen("S:\S8RENTE\Aktieanalyse\Vaerktoejer\Aktieoverblik\Aktieoverblik - Sektoropdeling\Aktieoverblik_PPT - Sektor.pptx")
    If Not fOpen Then
        Set appPPT = CreateObject(class:="PowerPoint.Application")
        Set oPPT = appPPT.Presentations.Open("S:\S8RENTE\Aktieanalyse\Vaerktoejer\Aktieoverblik\Aktieoverblik - Sektoropdeling\Aktieoverblik_PPT - Sektor.pptx")
    Else
        Set appPPT = GetObject(class:="PowerPoint.Application")
        Set oPPT = appPPT.Presentations("Udkast til Aktieoverblik.pptx")
    End If
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Set oWS = ActiveWorkbook.Worksheets("PPT DATA")
    Set owb = ActiveWorkbook
                
                        If oWS.cells(k, 37) = "1" Then
                            Set wdPic = .Cell(k, 37).Range.InlineShapes.AddPicture(filename:=ESG1, _
                            LinkToFile:=False, SaveWithDocument:=True)
                        If oWS.cells(k, 37) = "2" Then
                            Set wdPic = .Cell(k, 37).Range.InlineShapes.AddPicture(filename:=ESG2, _
                            LinkToFile:=False, SaveWithDocument:=True)
                        If oWS.cells(k, 37) = "3" Then
                            Set wdPic = .Cell(k, 37).Range.InlineShapes.AddPicture(filename:=ESG3, _
                            LinkToFile:=False, SaveWithDocument:=True)
                        If oWS.cells(k, 37) = "4" Then
                            Set wdPic = .Cell(k, 37).Range.InlineShapes.AddPicture(filename:=ESG4, _
                            LinkToFile:=False, SaveWithDocument:=True)
                        If oWS.cells(k, 37) = "5" Then
                            Set wdPic = .Cell(k, 37).Range.InlineShapes.AddPicture(filename:=ESG5, _
                            LinkToFile:=False, SaveWithDocument:=True)

                        End If
                            wdPic.Height = 0.3 * 28.34646
                            wdPic.Width = 0.3 * 28.34646
                            Set wdPic2 = wdPic.ConvertToShape
                            wdPic2.Left = CentimetersToPoints(4 - (y * 0.3))
                        y = y + 1
End With
End Sub

我知道以上可能是完全错误的，但我迷路了。

excel

vba

image

powerpoint

回答 2

Stack Overflow用户

发布于 2022-11-02 13:39:06

也许是这样的。

Sub InsertPics()
Dim fPath As String, fName As String
Dim r As Range, rng As Range

Application.ScreenUpdating = False
fPath = "C:\Pictures\"
Set rng = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
i = 1
For Each r In rng
    fName = Dir(fPath)
    Do While fName <> ""
            With ActiveSheet.Pictures.Insert(fPath & fName)
                .ShapeRange.LockAspectRatio = msoTrue
                Set px = .ShapeRange
                If .ShapeRange.Width > Rows(i).Columns(2).Width Then .ShapeRange.Width = Columns(2).Width
                    With Cells(i, 2)
                        px.Top = .Top
                        px.Left = .Left
                        .RowHeight = px.Height
                    End With
            End With
            i = i + 1
        fName = Dir
    Loop
Next r
Application.ScreenUpdating = True
End Sub


' Note: you need the file extension, such as ',jpg', or whatever you are using, so you can match on that.
Sub Insert()
    Dim strFolder As String
    Dim strFileName As String
    Dim objPic As Picture
    Dim rngCell As Range
    strFolder = "C:\Pictures\" 'change the path accordingly
    If Right(strFolder, 1) <> "\" Then
        strFolder = strFolder & "\"
    End If
    Set rngCell = Range("E1") 'starting cell
    strFileName = Dir(strFolder & "*.jpg", vbNormal) 'filter for .png files
    Do While Len(strFileName) > 0
        Set objPic = ActiveSheet.Pictures.Insert(strFolder & strFileName)
        With objPic
            .Left = rngCell.Left
            .Top = rngCell.Top
            .Height = rngCell.RowHeight
            .Placement = xlMoveAndSize
        End With
        Set rngCell = rngCell.Offset(1, 0)
        strFileName = Dir
    Loop
End Sub

票数 0

Stack Overflow用户

发布于 2022-11-02 23:45:55

一个小问题是: PowerPoint表不能保存图形，只能保存文本。您可以使用图片的顶部和左侧属性在网格中定位图片，但是使用表格来定位它们是行不通的。

您可以使用图片填充单元格作为背景，但单元格尺寸必须与图片匹配，以避免失真。要做到这一点，请使用如下语句：

ActivePresentation.Slides(1).Shapes(1).Table.Cell(1, 2).Shape.Fill.UserPicture ("C:\Filepath\Filename")

票数 0

页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持

原文链接：

https://stackoverflow.com/questions/74286513

复制

相似问题

问VBA:基于Excel的单元格值在PowerPoint文件夹中插入图片
EN

回答 2

Stack Overflow用户

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问VBA:基于Excel的单元格值在PowerPoint文件夹中插入图片EN

回答 2

Stack Overflow用户

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问VBA:基于Excel的单元格值在PowerPoint文件夹中插入图片
EN