将信息从 Excel 转换为 PPT - 特定字段

Question

我想检查是否有可能找到另一个具有相同目标的代码，即从 Excel 中的特定单元格获取信息并将其粘贴到 powerpoint 字段中。

这是我的基本代码。我自己创造的。

Sub PasteExcelDataIntoPowerPointTextbox()
    Dim ppApp As Object
    Dim ppSlide As Object
    Dim ppTextBox As Object
    Dim xlApp As Excel.Application
    Dim xlWorkbook As Excel.Workbook
    Dim xlWorksheet As Excel.Worksheet
    Dim excelRange As Excel.Range
    
    ' Initialize PowerPoint and Excel
    Set ppApp = CreateObject("PowerPoint.Application")
    ppApp.Visible = True ' Make PowerPoint visible
       
    ' Open the PowerPoint presentation
    Set ppPresentation = ppApp.Presentations.Open("C:\Users\Public\HiringResultsNew.pptx")
       
    ' Assuming the Excel file is already open, else you can open it too
    Set xlApp = GetObject(, "Excel.Application")
    Set xlWorkbook = xlApp.ActiveWorkbook
    Set xlWorksheet = xlWorkbook.Worksheets("HiringResults") ' Change to your sheet name
    
    ' Get the range of Excel data you want to copy
    Set excelRange = xlWorksheet.Range("C1")
    Set ppSlide = ppPresentation.Slides(1)
    Set ppTextBox = ppSlide.Shapes("REFTYPE").TextFrame.TextRange
    excelRange.Copy
    ppTextBox.Paste
        
    Set excelRange = xlWorksheet.Range("C2")
    Set ppSlide = ppPresentation.Slides(1)
    Set ppTextBox = ppSlide.Shapes("REFBUSINESS").TextFrame.TextRange
    excelRange.Copy
    ppTextBox.Paste
        
    Set excelRange = xlWorksheet.Range("D3")
    Set ppSlide = ppPresentation.Slides(1)
    Set ppTextBox = ppSlide.Shapes("REFNUMBERFILLS").TextFrame.TextRange
    excelRange.Copy
    ppTextBox.Paste
        
    Set excelRange = xlWorksheet.Range("D4")
    Set ppSlide = ppPresentation.Slides(1)
    Set ppTextBox = ppSlide.Shapes("REFVARIATION").TextFrame.TextRange
    excelRange.Copy
    ppTextBox.Paste
        
    Set excelRange = xlWorksheet.Range("D5")
    Set ppSlide = ppPresentation.Slides(1)
    Set ppTextBox = ppSlide.Shapes("REFTTF").TextFrame.TextRange
    excelRange.Copy
    ppTextBox.Paste   
    
    Set excelRange = xlWorksheet.Range("D6")
    Set ppSlide = ppPresentation.Slides(1)
    Set ppTextBox = ppSlide.Shapes("REFCNPS").TextFrame.TextRange
    excelRange.Copy
    ppTextBox.Paste
    
    
    Set excelRange = xlWorksheet.Range("D7")
    Set ppSlide = ppPresentation.Slides(1)
    Set ppTextBox = ppSlide.Shapes("REFHMNPS").TextFrame.TextRange
    excelRange.Copy
    ppTextBox.Paste
      
    Set excelRange = xlWorksheet.Range("D8")
    Set ppSlide = ppPresentation.Slides(1)
    Set ppTextBox = ppSlide.Shapes("REFACTREQ").TextFrame.TextRange
    excelRange.Copy
    ppTextBox.Paste
    
    Set excelRange = xlWorksheet.Range("D9")
    Set ppSlide = ppPresentation.Slides(1)
    Set ppTextBox = ppSlide.Shapes("REFDIVMALE").TextFrame.TextRange
    excelRange.Copy
    ppTextBox.Paste
    
    Set excelRange = xlWorksheet.Range("D10")
    Set ppSlide = ppPresentation.Slides(1)
    Set ppTextBox = ppSlide.Shapes("REFDIVFAME").TextFrame.TextRange
    excelRange.Copy
    ppTextBox.Paste
    
    Set excelRange = xlWorksheet.Range("D11")
    Set ppSlide = ppPresentation.Slides(1)
    Set ppTextBox = ppSlide.Shapes("REFHIREINT").TextFrame.TextRange
    excelRange.Copy
    ppTextBox.Paste
    
    Set excelRange = xlWorksheet.Range("D12")
    Set ppSlide = ppPresentation.Slides(1)
    Set ppTextBox = ppSlide.Shapes("REFHIREEXT").TextFrame.TextRange
    excelRange.Copy
    ppTextBox.Paste
    
    Set excelRange = xlWorksheet.Range("D13")
    Set ppSlide = ppPresentation.Slides(1)
    Set ppTextBox = ppSlide.Shapes("REFTSTASO").TextFrame.TextRange
    excelRange.Copy
    ppTextBox.Paste
    
    Set excelRange = xlWorksheet.Range("D14")
    Set ppSlide = ppPresentation.Slides(1)
    Set ppTextBox = ppSlide.Shapes("REFTSEMRE").TextFrame.TextRange
    excelRange.Copy
    ppTextBox.Paste
    
    Set excelRange = xlWorksheet.Range("D15")
    Set ppSlide = ppPresentation.Slides(1)
    Set ppTextBox = ppSlide.Shapes("REFTSAGENC").TextFrame.TextRange
    excelRange.Copy
    ppTextBox.Paste
    
    Set excelRange = xlWorksheet.Range("D16")
    Set ppSlide = ppPresentation.Slides(1)
    Set ppTextBox = ppSlide.Shapes("REFLEVEX").TextFrame.TextRange
    excelRange.Copy
    ppTextBox.Paste
    
    Set excelRange = xlWorksheet.Range("D17")
    Set ppSlide = ppPresentation.Slides(1)
    Set ppTextBox = ppSlide.Shapes("REFLEVDI").TextFrame.TextRange
    excelRange.Copy
    ppTextBox.Paste
    
    Set excelRange = xlWorksheet.Range("D18")
    Set ppSlide = ppPresentation.Slides(1)
    Set ppTextBox = ppSlide.Shapes("REFLEVMA").TextFrame.TextRange
    excelRange.Copy
    ppTextBox.Paste
    
    Set excelRange = xlWorksheet.Range("D19")
    Set ppSlide = ppPresentation.Slides(1)
    Set ppTextBox = ppSlide.Shapes("REFLEVIN").TextFrame.TextRange
    excelRange.Copy
    ppTextBox.Paste
    
    Set excelRange = xlWorksheet.Range("D20")
    Set ppSlide = ppPresentation.Slides(1)
    Set ppTextBox = ppSlide.Shapes("REFDATAREF").TextFrame.TextRange
    excelRange.Copy
    ppTextBox.Paste
    
    Set excelRange = xlWorksheet.Range("D21")
    Set ppSlide = ppPresentation.Slides(1)
    Set ppTextBox = ppSlide.Shapes("REFKEYINSIGHTS").TextFrame.TextRange
    excelRange.Copy
    ppTextBox.Paste
       
    ' Clean up
    Set ppApp = Nothing
    Set xlApp = Nothing
    Set xlWorkbook = Nothing
    Set xlWorksheet = Nothing
    Set ppPresentation = Nothing
    
    MsgBox "Report completed. Please edit and save it."
 
End Sub

Answer 1

• 使用循环来简化代码
• 使用 TextBoxes 的

  Text

  属性来更新其内容

    ' Get the range of Excel data you want to copy
    Dim arrCell, arrShp, i as Long
    arrCell=Array("C1","C2","D3","D4","D5","D6","D7","D8","D9","D10","D11","D12","D13","D14","D15","D16","D17","D18","D19","D20","D21")
    arrShp=Array("REFTYPE","REFBUSINESS","REFNUMBERFILLS","REFVARIATION","REFTTF","REFCNPS","REFHMNPS","REFACTREQ","REFDIVMALE","REFDIVFAME","REFHIREINT","REFHIREEXT","REFTSTASO","REFTSEMRE","REFTSAGENC","REFLEVEX","REFLEVDI","REFLEVMA","REFLEVIN","REFDATAREF","REFKEYINSIGHTS")

    Set ppSlide = ppPresentation.Slides(1)
    For i = LBound(arrCell) To UBound(arrCell)
        Set excelRange = xlWorksheet.Range(arrCell(i))
        Set ppTextBox = ppSlide.Shapes(arrShp(i)).TextFrame.TextRange
        ppTextBox.Text = excelRange.Text
    Next