Excel VBA 无法识别 Powerpoint 中的形状选择

Question

Dim ppapp As PowerPoint.Application
Dim pppres As PowerPoint.Presentation
Sub getshapedata()
On Error GoTo line1
Set ppapp = GetObject(, "Powerpoint.application")
Set pppres = ppapp.ActivePresentation
Dim shapeslide
Dim shapename
Dim shapetext
Dim nextrow
shapeslide = ppapp.ActiveWindow.View.Slide.SlideIndex
shapename = ppapp.ActiveWindow.Selection.ShapeRange(1).Name
shapetext = pppres.Slides(shapeslide).Shapes(shapename).TextEffect.Text
friendlyname = InputBox("Insert Friendly Name for " & shapetext, "Friendly Name", "")
nextrow = Sheet1.Range("a" & Rows.Count).End(xlUp).Row + 1
Sheet1.Range("a" & nextrow) = shapeslide
Sheet1.Range("b" & nextrow) = shapename
Sheet1.Range("c" & nextrow) = shapetext
Sheet1.Range("d" & nextrow) = friendlyname
Exit Sub

line1:
MsgBox "No item selected"
End Sub
Sub writedata()
Dim c As Object
Dim shapeslide
Dim shapename
Dim shapetext
Set ppapp = GetObject(, "Powerpoint.application")
Set pppres = ppapp.ActivePresentation
For Each c In Sheet1.Range("a2:a" & Sheet1.Range("a" & Rows.Count).End(xlUp).Row)
shapeslide = Sheet1.Range("a" & c.Row)
shapename = Sheet1.Range("b" & c.Row)
shapetext = Sheet1.Range("c" & c.Row).Text
friendlyname = Sheet1.Range("d" & c.Row)
pppres.Slides(shapeslide).Shapes(shapename).TextEffect.Text = shapetext
Next c
End Sub

大家好我正在使用上面的代码来更新Excel VBA的PowerPoint中的数据，我在Windows 7上的Office 2016中使用它。

遵循代码的准确之后，当我选择一个形状时，它会识别框和内容，然后要求我分配一个友好的名称，但然后跳到错误：未选择项目，调试中指示的行是：

nextrow = Sheet1.Range("a" & Rows.Count).End(xlUp).Row + 1

如果您能告诉我如何解决此

Answer 1

我找到了我问题的答案，我会把它放在以后可能使用的任何人：

：

Dim ppapp As PowerPoint.Application
Dim pppres As PowerPoint.Presentation
Sub getshapedata()
Dim shapeslide As Integer
Dim shapename As String
Dim shapetext As String
Dim friendlyname As String
Dim nextrow As Long
On Error GoTo line1
Set ppapp = GetObject(, "Powerpoint.application")
Set pppres = ppapp.ActivePresentation
shapeslide = ppapp.ActiveWindow.View.Slide.SlideIndex
shapename = ppapp.ActiveWindow.Selection.ShapeRange(1).Name
shapetext = pppres.Slides(shapeslide).Shapes(shapename).TextEffect.Text
friendlyname = InputBox("Insert Friendly Name for " & shapetext, "Friendly Name", "")
With ActiveSheet
    nextrow = .Range("a" & .Rows.Count).End(xlUp).Row + 1
    .Range("a" & nextrow) = shapeslide
    .Range("b" & nextrow) = shapename
    .Range("c" & nextrow) = shapetext
    .Range("d" & nextrow) = friendlyname
End With
Exit Sub
line1:
    MsgBox "No item selected"
End Sub
Sub writedata()
Dim c As Range
Dim shapeslide As Integer
Dim shapename As String
Dim shapetext As String
Dim friendlyname As String
Set ppapp = GetObject(, "Powerpoint.application")
Set pppres = ppapp.ActivePresentation
With ActiveSheet
    For Each c In .Range("a2:a" & .Range("a" & .Rows.Count).End(xlUp).Row)
        shapeslide = .Range("a" & c.Row)
        shapename = .Range("b" & c.Row)
        shapetext = .Range("c" & c.Row).Text
        friendlyname = .Range("d" & c.Row)
        pppres.Slides(shapeslide).Shapes(shapename).TextEffect.Text = shapetext
    Next c
End With
End Sub