在VBA中更改文本框的颜色(阴影/颜色渐变)

时间:2015-09-29 09:43:59

标签: vba powerpoint gradient powerpoint-vba backcolor

我正在尝试在我的PowerPoint演示文稿的开头插入自动摘要在VBA中。 (我是Visual Basic的新手)

我找到了给我参考的代码,但我似乎无法弄清楚一个形状的颜色渐变。

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

互联网上的文档说该方法是ForeColor和BackColor,但我似乎无法让它工作。我不明白为什么第二种颜色是白色而不是暗红色,因为它的RGB代码说。

我当前的模板侧面有标题,右侧有垂直文字。文本框使用RGB(208,30,60)到RGB(97,18,30)的阴影线性着色,角度为270°。

这是完整的VBA代码(最后) enter image description here

这就是我想要的(使用VBA幻灯片中显示的数字) the template I need for that summary

完整代码:

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

提前谢谢

1 个答案:

答案 0 :(得分:1)

我从Excel宏录制器中选择了它,因为Shapes和大多数对象在Office应用程序之间仍然有很多公共部分。

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

你只需要"附加" (将Selection)替换为您的文本框,但我认为您可以处理它。我将编辑我的答案,以包括我在评论中给你的所有指针。