Changing the color of a textbox in VBA (shading off/colour gradient)

10,171

I picked that from Excel macro recorder, as Shapes and most of the objects still have a lot of commons parts between Office applications.

ActiveSheet.Shapes.Range(Array("TextBox 1")).Select
With Selection.ShapeRange
    With .Fill
        .ForeColor.RGB = RGB(255, 0, 0)
        .BackColor.RGB = RGB(0, 0, 1)
        .TwoColorGradient msoGradientHorizontal, 1
        .RotateWithObject = msoTrue
        .Visible = msoTrue
    End With
    With .TextFrame2.TextRange.Font
        .BaselineOffset = 0
        .Spacing = 1.6
    End With
End With

You only need to "attach" (replace the Selection) it to your textbox, but I think you can handle that. I'll edit my answer to include all pointers I gave you in comments too.

Share:
10,171
Amandine FAURILLOU
Author by

Amandine FAURILLOU

Graduate of the University of Montpellier, my first job was in a startup as a Data Miner, where I mostly used R and Excel. At the university, R is what I used most, then a little of SAS, and SPSS. At my first job, it was R and Excel/VBA. I like learning, this is why I decided to dip my toes into VBA and also Python. My hobbies include being a TV Enthusiast, a movies somewhat enthusiast, a bike newbie (the VTT kind, not the motor kind) and a board game enthusiast.

Updated on June 04, 2022

Comments

  • Amandine FAURILLOU
    Amandine FAURILLOU about 2 years

    I am trying to insert an automated summary at the beginning of my PowerPoint presentation in VBA. (I am fairly new to Visual Basic)

    I have found the code that gives me the references, but I can't seem to figure out the colour gradient of one shape.

    With ActivePresentation.Slides(1)
    .Shapes(1).Fill.Visible = msoTrue
    .Shapes(1).Fill.ForeColor.RGB = RGB(208, 30, 60)
    .Shapes(1).Fill.BackColor.RGB = RGB(97, 18, 30)
    .Shapes(1).Fill.TwoColorGradient msoGradientHorizontal, 2
    .Shapes(1).Line.Visible = msoFalse
    

    The doc on the internet says the method is ForeColor and BackColor, but I can't seem to get it working. I don't understand why the second color is white and not dark red as its RGB code says.

    my current template has the title on the side, and vertical, text towards the right side. The textbox is colored with a shading from RGB(208, 30, 60) to RGB(97, 18, 30) linearly with an angle of 270°.

    this what is given by the complete VBA code (at the end) enter image description here

    This what I would like to have (with the numbers as shown in the VBA Slide) the template I need for that summary

    Complete code:

    Sub Sommaire()
    Dim Diapo As Slide
    Dim titre As Shape
    Dim petit_titre As Shape
    Dim texte_ajout As TextRange
    Dim texte_sommaire As TextRange
    Dim ligne_sommaire As TextRange
    Dim y As Byte
    'Si le titre de la première diapo est "Sommaire", elle sera supprimée
    'cela permet de relancer la macro autant de fois que l'on souhaite
    'sans avoir à supprimer la diapo de sommaire
    If ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange = "SOMMAIRE" Then
    ActivePresentation.Slides(1).Delete
    End If
    ' ajoute une diapo en début de présentation avec
    'la disposition de mise en titre n°2 du masque
    ActivePresentation.Slides.Add Index:=1, Layout:=ppLayoutText
    
    With ActivePresentation.Slides(1)
    .Shapes(1).TextFrame.TextRange = "SOMMAIRE"
    .Shapes(1).TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
    .Shapes(1).TextFrame.TextRange.Font.Name = "Arial Black"
    .Shapes(1).TextFrame.TextRange.Font.Size = 24
    .Shapes(1).TextFrame2.TextRange.Font.Spacing = 3
    
    
    .Shapes(1).TextFrame2.VerticalAnchor = msoAnchorBottom
    .Shapes(1).TextFrame2.TextRange.ParagraphFormat.Alignment = _
            msoAlignLeft
    
    .Shapes(1).TextFrame2.MarginLeft = 14.1732283465
    .Shapes(1).TextFrame2.MarginRight = 14.1732283465
    .Shapes(1).TextFrame2.MarginTop = 14.1732283465
    .Shapes(1).TextFrame2.MarginBottom = 28.3464566929
    .Shapes(1).TextFrame2.WordWrap = msoTrue
    .Shapes(1).TextFrame.Orientation = msoTextOrientationUpward
    .Shapes(1).Left = 0 * 72
    .Shapes(1).Top = 0 * 72
    .Shapes(1).Height = ActivePresentation.PageSetup.SlideHeight
    .Shapes(1).Width = 0.975 * 72
    
    .Shapes(1).Fill.Visible = msoTrue
    .Shapes(1).Fill.ForeColor.RGB = RGB(208, 30, 60)
    .Shapes(1).Fill.BackColor.RGB = RGB(97, 18, 30)
    .Shapes(1).Fill.TwoColorGradient msoGradientHorizontal, 2
    .Shapes(1).Line.Visible = msoFalse
    
    .Shapes(1).Shadow.Type = msoShadow25
    .Shapes(1).Shadow.Visible = msoTrue
    .Shapes(1).Shadow.Style = msoShadowStyleInnerShadow
    .Shapes(1).Shadow.Blur = 5
    .Shapes(1).Shadow.OffsetX = 3.9993907806
    .Shapes(1).Shadow.OffsetY = -0.0698096257
    .Shapes(1).Shadow.ForeColor.RGB = RGB(52, 9, 16)
    .Shapes(1).Shadow.Transparency = 0.5
    
    
    Set texte_ajout = .Shapes(2).TextFrame.TextRange
    End With
    
    With ActivePresentation.Slides(1).Shapes _
         .AddShape(msoShapeRectangle, 1.5275 * 72, 32.7, 180, 29.1)
        .TextFrame.TextRange.Text = "Sommaire"
        .TextFrame.MarginBottom = 10
        .TextFrame.MarginLeft = 10
        .TextFrame.MarginRight = 10
        .TextFrame.MarginTop = 10
        .TextFrame.TextRange.Font.Name = "Arial Black"
        .TextFrame.TextRange.Font.Size = 18
        .TextFrame2.VerticalAnchor = msoAnchorMiddle
            .TextFrame2.TextRange.ParagraphFormat.Alignment = _
            msoAlignLeft
        .Fill.Visible = msoFalse
        .Line.Visible = msoFalse
        .TextFrame2.TextRange.Characters(1, 1).Font.Fill.ForeColor.RGB = RGB(208, 30, 60)
        .TextFrame2.TextRange.Characters(2, 7).Font.Fill.ForeColor.RGB = RGB(39, 39, 39)
        .Shadow.Visible = msoFalse
    
        End With
    
    
    
    
    
    
    
    'boucle sur toutes les diapos à partir de la 2e
    For y = 2 To ActivePresentation.Slides.Count
    Set Diapo = ActivePresentation.Slides(y)
    'si la diapo a un titre
    If Diapo.Shapes.HasTitle Then
    Set titre = Diapo.Shapes.Title
    texte_ajout = texte_ajout & Format(y, "0 - ") & titre.TextFrame. _
    TextRange.Text & Chr(13) & vbCrLf
    End If
    Next y
    'ajout de liens aux items du sommaire
    Set texte_sommaire = _
    ActivePresentation.Slides(1).Shapes(2).TextFrame.TextRange
    texte_sommaire.Font.Size = 20
    texte_sommaire.Font.Color.RGB = RGB(39, 39, 39)
    
    With ActivePresentation.Slides(1).Shapes(2)
    .Left = 1.5275 * 72
    .Top = 1.9 * 72
    End With
    
    End Sub
    

    Thank you in advance