Consulting

Results 1 to 5 of 5

Thread: Copying text font color from first cell to all cells in a table row

  1. #1
    VBAX Newbie
    Joined
    Nov 2017
    Posts
    3
    Location

    Copying text font color from first cell to all cells in a table row

    Hi, I have a powerpoint presentation and each slide has a table

    for each row in the table, I want to copy the color of the text in the first cell to all cells in the same row
    this is the code but it just does not do anything

    thank you

    Sub ChangeColor(sStart As Integer, sEnd As Integer)
       Dim sColor As Long
       Dim oSld As Slide
       Dim oShp As Shape
       Dim oRow As Row
       Dim oCell As Cell
       Dim x As Long
       Dim oColor As Long
        
        With ActivePresentation
         For I = sStart To sEnd + 1
               Set oSld = ActivePresentation.Slides(I)
                   For Each oShp In oSld.Shapes
                       If oShp.HasTable Then
                           For Each oRow In oShp.Table.Rows
                               For Each oCell In oRow.Cells
                                   If oCell.Shape.TextFrame.HasText Then
                                      With oCell.Shape.TextFrame.TextRange
                                               For x = 1 To .Runs.Count
                                                      If x = 1 Then
                                                         oColor = .Runs(x).Font.Color.RGB
                                                      Else
                                                         .Runs(x).Font.Color.RGB = oColor
                                                     End If
                                              Next x
                                      End With
                                      End If 'has text
                                  Next oCell
                            Next oRow
                         End If
                        Next oShp
         Next I
    End With
    End Sub
    Last edited by SamT; 11-08-2017 at 04:58 PM.

  2. #2
    VBAX Newbie
    Joined
    Nov 2017
    Posts
    3
    Location
    I apologize for not being able to show the code in indent format. in edit mode, it shows correctly but after posting all lines are left justified
    I would like to know how to sow it properly
    thanks

  3. #3
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    Leading spaces are trimmed in View Mode.

    You can use the # icon to insert Code Formatting Tags around the selected Text.
    you can also Insert the Code Formatting Tags, then Paste the code between them.

    I don't do PowerPoint, but place "Option Explicit" at the very top of the code module, then Compile the code.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  4. #4
    VBAX Newbie
    Joined
    Nov 2017
    Posts
    3
    Location
    Thank you SamT for your prompt reply and assistance

  5. #5
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Try this


    Option Explicit
    
    Sub drv()
        Call ChangeColor(1, 3)
    End Sub
    
    Sub ChangeColor(sStart As Integer, sEnd As Integer)
        Dim sColor As Long
        Dim oSld As Slide
        Dim oShp As Shape
        Dim oRow As Row
        Dim oCell As Cell
        Dim x As Long, i As Long
        Dim oColor As Long
         
        With ActivePresentation
            For i = sStart To sEnd      '   why the +1 ?
                Set oSld = ActivePresentation.Slides(i)
                For Each oShp In oSld.Shapes
                    If oShp.HasTable Then
                        For Each oRow In oShp.Table.Rows
                            For Each oCell In oRow.Cells
                                If oCell.Shape.TextFrame.HasText Then
                                    oCell.Shape.TextFrame.TextRange.Font.Color.RGB = oRow.Cells(1).Shape.TextFrame.TextRange.Font.Color.RGB
                                End If 'has text
                            Next oCell
                        Next oRow
                    End If
                Next oShp
            Next i
        End With
    End Sub
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •