Méthode Application.AlignTableCellTop (Project)

Aligne le texte en haut de la cellule pour les cellules sélectionnées dans un tableau de rapport.

Syntaxe

expression. AlignTableCellTop

expressionUne variable qui représente un objetApplication.

Valeur renvoyée

Boolean

Exemple

Dans l’exemple suivant, la macro AlignTableCells aligne le texte de toutes les tables du rapport spécifié.

Sub TestAlignReportTables()
    Dim reportName As String
    Dim alignment As String   ' The value can be "top", "center", or "bottom".
    
    reportName = "Align Table Cells Report"
    alignment = "top"
    
    AlignTableCells reportName, alignment
End Sub

' Align the text for all tables in a specified report.
Sub AlignTableCells(reportName As String, alignment As String)
    Dim theReport As Report
    Dim shp As Shape
    
    Set theReport = ActiveProject.Reports(reportName)
    
    ' Activate the report. If the report is already active,
    ' ignore the run-time error 1004 from the Apply method.
    On Error Resume Next
    theReport.Apply
    On Error GoTo 0
    
    For Each shp In theReport.Shapes
        Debug.Print "Shape: " & shp.Type & ", " & shp.Name
        
        If shp.HasTable Then
            shp.Select
            
            Select Case alignment
                Case "top"
                    AlignTableCellTop
                Case "center"
                    AlignTableCellVerticalCenter
                Case "bottom"
                    AlignTableCellBottom
                Case Else
                    Debug.Print "AlignTableCells error: " & vbCrLf _
                        & "alignment must be top, center, or bottom."
                End Select
        End If
    Next shp
End Sub

Voir aussi

Objet Application

Méthode AligntableCellVerticalCenter, méthodeAligntableCellBottom de l’objet Report

Assistance et commentaires

Avez-vous des questions ou des commentaires sur Office VBA ou sur cette documentation ? Consultez la rubrique concernant l’assistance pour Office VBA et l’envoi de commentaires afin d’obtenir des instructions pour recevoir une assistance et envoyer vos commentaires.