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

Amandine FAURILLOU picture Amandine FAURILLOU · Sep 29, 2015 · Viewed 9.4k times · Source

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

Answer

R3uK picture R3uK · Sep 30, 2015

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.