Objeto Shapes (Project)
Representa una colección de objetos Shape en un informe personalizado.
Utilice la propiedad Report.Shapes para obtener el objeto de colección Shapes . En el ejemplo siguiente, el informe debe ser la vista activa para obtener la colección Shapes ; De lo contrario, obtendrá un error 424 en tiempo de ejecución (objeto necesario) en la For Each oShape In oReport.Shapes
instrucción .
Sub ListShapesInReport()
Dim oReports As Reports
Dim oReport As Report
Dim oShape As shape
Dim reportName As String
Dim msg As String
Dim msgBoxTitle As String
Dim numShapes As Integer
numShapes = 0
msg = ""
reportName = "Table Tests"
Set oReports = ActiveProject.Reports
If oReports.IsPresent(reportName) Then
' Make the report the active view.
oReports(reportName).Apply
Set oReport = oReports(reportName)
msgBoxTitle = "Shapes in report: '" & oReport.Name & "'"
For Each oShape In oReport.Shapes
numShapes = numShapes + 1
msg = msg & numShapes & ". Shape type: " & CStr(oShape.Type) _
& ", '" & oShape.Name & "'" & vbCrLf
Next oShape
If numShapes > 0 Then
MsgBox Prompt:=msg, Title:=msgBoxTitle
Else
MsgBox Prompt:="This report contains no shapes.", _
Title:=msgBoxTitle
End If
Else
MsgBox Prompt:="The requested report, '" & reportName _
& "', does not exist.", Title:="Report error"
End If
End Sub
Nombre |
---|
AddCallout |
AddChart |
AddConnector |
AddCurve |
AddLabel |
AddLine |
AddPolyline |
AddShape |
AddTable |
AddTextbox |
AddTextEffect |
BuildFreeform |
Elemento |
Rango |
SelectAll |
Nombre |
---|
Background |
Count |
Default |
Parent |
Valor |
Objeto ShapeRange del objeto De informede formas
¿Tiene preguntas o comentarios sobre VBA para Office o esta documentación? Vea Soporte técnico y comentarios sobre VBA para Office para obtener ayuda sobre las formas en las que puede recibir soporte técnico y enviar comentarios.