我正在尝试使用 VBA 宏将 excel 电子表格中的信息写入 Powerpoint

Question

我在 VBA 方面有些经验不足，所以我的问题可能很基础。我有一个包含房间号列表的电子表格，我需要将它们复制到将运行作为显示的 powerpoint 演示文稿中。

我的计划是在一张幻灯片上放一个按钮来更新演示文稿。到目前为止，我已经为该按钮编写了如下代码：

Sub CommandButton1_Click()
Dim xlapp As Excel.Application
Dim xldoc As Excel.Workbook
Dim Cell As Range
Dim rng As Range
Dim shapeslide
Dim shapename
Dim shapetext

Set xlapp = GetObject(, "Excel.Application")
Set xldoc = xlapp.ActiveWorkbook

Set rng = xldoc.Sheets(Sheet1).Range("a2:a" & Range("a" & xldoc.Sheets(Sheet1).Rows.Count).End(xlUp).Row)
For Each Cell In rng

shapeslide = Sheet1.Range("a" & Cell.Row)
shapename = Sheet1.Range("b" & Cell.Row)
shapetext = Sheet1.Range("c" & Cell.Row)

ActivePresentation.Slides(shapeslide).Shapes(shapename).TextEffect.Text = 
shapetext
Next Cell

ActivePresentation.Save
ActivePresentation.SlideShowSettings.Run

End Sub

但是我在行 Set rng = xldoc.Sheets(Sheet1).Range("a2:a" & Range("a" & xldoc.Sheets(Sheet1).Rows.Count).End(xlUp).Row) 中收到一个错误，上面写着 "Subscript out of range."

作为参考，这里是相关的 excel 文档（这是我正在测试的更小更简单的版本）。

|---------------------|------------------|---------------------|
|      Index          |     Shape Name   |      Value          |
|---------------------|------------------|---------------------|
|          1          |     Subtitle 2   |      Room 133       |
|---------------------|------------------|---------------------|
|          2          |   Placeholder 2  |      Room 140       |
|---------------------|------------------|---------------------|
|          3          |   Placeholder 2  |      Room 220       |
|---------------------|------------------|---------------------|
|          4          |   Placeholder 2  |      Room 300       |
|---------------------|------------------|---------------------|

我知道这只是一个简单的错误，我知道 "subscript out of range" 消息的含义，但我不知道是什么原因造成的。

Answer 1

这个：

Set rng = xldoc.Sheets(Sheet1).Range("a2:a" & _
      Range("a" & xldoc.Sheets(Sheet1).Rows.Count).End(xlUp).Row)

也许应该是：

With xldoc.Sheets("Sheet1")
    Set rng = .Range("a2:a" & .Range("a" & .Rows.Count).End(xlUp).Row)
End With

假设 sheet 的选项卡名称是 "Sheet1"。

编辑：其余代码

Sub CommandButton1_Click()

    Dim xlapp As Excel.Application
    Dim xldoc As Excel.Workbook
    Dim Cell As Range
    Dim rng As Range
    Dim shapeslide
    Dim shapename
    Dim shapetext
    Dim sht As Excel.WorkSheet

    'see if Excel is open
    On Error Resume Next
    Set xlapp = GetObject(, "Excel.Application")
    On Error Goto 0

    If xlapp Is Nothing then
        Msgbox "Excel is not open!"
        Exit sub
    End If

    Set xldoc = xlapp.ActiveWorkbook
    Set sht = xldoc.Sheets("Sheet1")

    Set rng = sht.Range("a2:a" & sht.Range("a" & sht.Rows.Count).End(xlUp).Row)

    For Each Cell In rng.Cells

        shapeslide = sht.Range("a" & Cell.Row)
        shapename = sht.Range("b" & Cell.Row)
        shapetext = sht.Range("c" & Cell.Row)
        ActivePresentation.Slides(shapeslide).Shapes( _
                shapename).TextEffect.Text = shapetext
    Next Cell

    ActivePresentation.Save
    ActivePresentation.SlideShowSettings.Run

End Sub

我正在尝试使用 VBA 宏将 excel 电子表格中的信息写入 Powerpoint

I am trying to write information from an excel spreadsheet to a Powerpoint using VBA macros

excel

powerpoint

vba