Powerpoint VBA-创建形状的写入函数

我有以下功能，我打算创建一个形状：

Public Function LinkToAddInfo(ShapeName As String, BoxName As String, DisplayNumber As Long, AddName As String, TrueNumber As Long) As Shape

        Dim ShapeName As Shape
        Set ShapeName = .Shapes.AddShape(msoShapeRoundedRectangle, 640, 470, 71, 27)

        With ShapeName
            .Fill.ForeColor.RGB = RGB(191, 191, 191)
            .Fill.Transparency = 0
            .Name = BoxName

            With .Line
            .Weight = 0
            .ForeColor.RGB = RGB(191, 191, 191)
            .Transparency = 0
            End With ' Outline

            With .TextFrame.TextRange
              .Text = "Add. Info " & DisplayNumber & vbNewLine & AddName
               With .Font
                .Name = "Arial"
                .Size = 8
                .Bold = msoTrue
                .BaselineOffset = 0
                .AutoRotateNumbers = msoFalse
                .Color.RGB = RGB(255, 255, 255)
            End With   ' Font

           End With   ' TextFrame

        End With ' Square itself

End Function

我尝试在模块内使用以下命令调用它：

LinkToAddInfo("tiny1", "Yedinfo1", DisplayNumber, AddName, AddNumber)

但它会抛出一个错误（编辑器中的代码以红色显示）

当我拥有模块本身的所有代码时，它工作得很好。我只是在努力将它转录成一个外部函数（我想这样做，这样我就不必一次又一次地重复这段代码）

---

如何实现这一点？

您在这方面有几个问题

• 您不需要函数，因为您没有将数据返回到程序。相反，使用Sub
• 第一个参数是一个字符串，但随后尝试在声明中使用与形状相同的变量名。但是您不使用任何字符串参数，因此可以删除它。您也不使用TrueNumber，因此可以将其删除
• 要访问幻灯片母版，您需要使用带有数字参数的设计，而不是SlideMaster。 以下操作应满足您的要求：

您可能有“编译错误：当前范围中的声明重复”。不能像参数名那样命名变量。将不同名称上的

Dim ShapeName更改为Shape

，或更改函数声明中第一个参数的名称。

Public Sub LinkToAddInfo(BoxName As String, DisplayNumber As Long, AddName As String)
    Dim oShape As Shape
    Set oShape = ActivePresentation.Designs(1).SlideMaster.Shapes.AddShape(msoShapeRoundedRectangle, 640, 470, 71, 27)

    With oShape
        .Fill.ForeColor.RGB = RGB(191, 191, 191)
        .Fill.Transparency = 0
        .Name = BoxName
        With .Line
        .Weight = 0
        .ForeColor.RGB = RGB(191, 191, 191)
        .Transparency = 0
        End With ' Outline
        With .TextFrame.TextRange
            .Text = "Add. Info " & DisplayNumber & vbNewLine & AddName
            With .Font
                .Name = "Arial"
                .Size = 8
                .Bold = msoTrue
                .BaselineOffset = 0
                .AutoRotateNumbers = msoFalse
                .Color.RGB = RGB(255, 255, 255)
            End With   ' Font
        End With   ' TextFrame
    End With ' Square itself
End Sub
```