Vba PowerPoint宏-需要为每张幻灯片添加带注释的矩形

我有一个PowerPoint，每张幻灯片都有注释。对于每张幻灯片，我想复制注释，创建一个带黑色边框的黄色矩形，然后将注释粘贴到矩形中

我开始将一个宏“拼接”在一起。这是我到目前为止所拥有的。它可以工作，但矩形位于顶部（需要位于底部），不确定如何将注释复制并粘贴到矩形中：

Dim oPPT As Presentation
Dim oSlide As Slide
Dim r As Integer
Dim i As Integer
Dim shapectr As Integer
Dim maxshapes As Integer
Dim oShape As Shape

Set oPPT = ActivePresentation


For i = 1 To oPPT.Slides.Count
    For shapectr = 1 To oPPT.Slides(i).Shapes.Count

            ActiveWindow.View.GotoSlide i

            Set oShape = ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeRectangle, 575.5, 9.12, 124.75, 34.12)
                oShape.Fill.ForeColor.RGB = RGB(255, 255, 204)
                oShape.Fill.BackColor.RGB = RGB(137, 143, 75)

            With oShape

               With .TextFrame.TextRange
                    .Text = "TEST"
                 With .Font
                    .Name = "Arial"
                    .Size = 18
                    .Bold = msoFalse
                    .Italic = msoFalse
                    .Underline = msoFalse
                    .Shadow = msoFalse
                    .Emboss = msoFalse
                    .BaselineOffset = 0
                    .AutoRotateNumbers = msoFalse
                    .Color.SchemeColor = ppForeground
                End With
               End With
            End With


    Next shapectr


    Next i

我需要将“TEST”替换为幻灯片备注区域中的文本（可以是几个句子）

我感谢你的帮助

Sub addShp()
Dim osld As Slide
Dim oshp As Shape
Dim oTR As TextRange
For Each osld In ActivePresentation.Slides
On Error Resume Next
osld.Shapes("NOTES").Delete
Set oshp = osld.Shapes.AddShape(msoShapeRectangle, 10, 400, 400, 100)
oshp.Name = "NOTES"
oshp.TextFrame.AutoSize = ppAutoSizeShapeToFitText
oshp.Fill.ForeColor.RGB = RGB(255, 255, 204)
oshp.Line.ForeColor.RGB = RGB(0, 0, 0)
With oshp.TextFrame.TextRange
If Not getNotes(osld) Is Nothing Then .Text = getNotes(osld).Text
.Font.Name = "Arial"
.Font.Size = 10
.Font.Color.RGB = vbBlack
 End With
 oshp.Top = ActivePresentation.PageSetup.SlideHeight - oshp.Height
 Next osld
 End Sub

Function getNotes(osld As Slide) As TextRange
' usually shapes(2) but not always
Dim oshp As Shape
For Each oshp In osld.NotesPage.Shapes
If oshp.Type = msoPlaceholder Then
If oshp.PlaceholderFormat.Type = ppPlaceholderBody Then
If oshp.TextFrame.HasText Then
Set getNotes = oshp.TextFrame.TextRange
End If
End If
End If
Next oshp
End Function

看看这是否更接近

我找到了左对齐文本并指定设置高度所需的“调整”。以下是最终代码：

Dim osld As Slide
Dim oshp As Shape
Dim oTR As TextRange

For Each osld In ActivePresentation.Slides

On Error Resume Next

osld.Shapes("NOTES").Delete

Set oshp = osld.Shapes.AddShape(msoShapeRectangle, 20, 400, 400, 300)
    oshp.Name = "NOTES"
    oshp.TextFrame.AutoSize = ppAutoSizeShapeToFitText
    oshp.Fill.ForeColor.RGB = RGB(255, 255, 204)
    oshp.Line.ForeColor.RGB = RGB(0, 0, 0)
    oshp.Line.Weight = 1.5

With oshp.TextFrame.TextRange
    If Not getNotes(osld) Is Nothing Then .Text = getNotes(osld).Text
    .Font.Name = "Arial"
    .Font.Size = 14
    .Font.Color.RGB = vbBlack
    .ParagraphFormat.Alignment = msoAlignLeft

End With

oshp.Width = 717

If oshp.Height < 105 Then
    oshp.Height = 105
End If
oshp.Left = 1
oshp.Top = ActivePresentation.PageSetup.SlideHeight - oshp.Height


Next osld

End Sub

Function getNotes(osld As Slide) As TextRange
' usually shapes(2) but not always
Dim oshp As Shape

For Each oshp In osld.NotesPage.Shapes
    If oshp.Type = msoPlaceholder Then
        If oshp.PlaceholderFormat.Type = ppPlaceholderBody Then
            If oshp.TextFrame.HasText Then
                Set getNotes = oshp.TextFrame.TextRange
            End If
        End If
    End If
Next oshp
End Function

将osld设置为幻灯片
将oshp调暗为形状
作为文本范围的Dim oTR
对于ActivePresentation.Slides中的每个osld
出错时继续下一步
osld.形状（“注释”）。删除
设置oshp=osld.Shapes.AddShape（msoShapeRectangle，20，400，400，300）
oshp.Name=“注释”
oshp.TextFrame.AutoSize=ppAutoSizeShapeToFitText
oshp.Fill.ForeColor.RGB=RGB（255、255、204）
oshp.Line.ForeColor.RGB=RGB（0,0,0）
oshp.Line.Weight=1.5
使用oshp.TextFrame.TextRange
如果不是getNotes（osld）则为Nothing，那么.Text=getNotes（osld）.Text
.Font.Name=“Arial”
.Font.Size=14
.Font.Color.RGB=vbBlack
.ParagraphFormat.Alignment=msoAlignLeft
以
oshp.宽度=717
如果oshp高度<105，则
oshp.高度=105
如果结束
oshp左=1
oshp.Top=ActivePresentation.PageSetup.SlideHeight-oshp.Height
下一个奥斯陆
端接头
函数getNotes（osld作为幻灯片）作为文本范围
“通常是形状（2），但不总是
将oshp调暗为形状
对于osld.NotesPage.Shapes中的每个oshp
如果oshp.Type=msoPlaceholder，则
如果oshp.PlaceholderFormat.Type=ppPlaceholderBody，则
如果是oshp.TextFrame.HasText，则
设置getNotes=oshp.TextFrame.TextRange
如果结束
如果结束
如果结束
下一个oshp
端函数

---

非常感谢你的帮助

这太棒了！还有一个问题，我想把盒子做成同样的大小，然后把整个幻灯片都看一遍。我使用什么命令来设置大小？（我知道我需要替换“oshp.TextFrame.AutoSize…”语句。非常感谢您的帮助！！！ActivePresentation.PageSetup.SlideHight和.SlideWidth将返回当前演示文稿幻灯片的高度和宽度。我有几个问题/调整：我还有两个问题………（1）如何开始特定幻灯片？（我试着用输入框和“for”语句来设置它，但后来它停止了工作------和（2）我没有注释，我怎么能不创建这个框？