不会用TwoColorGradient和SchemeColor,必须学会RGB。

ning84 · 发表于 2025-4-12 07:53

RGB颜色对照表 https://tool.oschina.net/commons?type=3

SchemeColor 属性 (Excel Graph) | Microsoft Learn https://learn.microsoft.com/zh-c ... i/excel.schemecolor

返回或设置指定 ChartColorFormat 对象的颜色作为当前配色方案中的索引。没有找到Schemecolor对应的值。

With myChart.ChartArea.Fill
.Visible = True
.ForeColor.SchemeColor = 15
.BackColor.SchemeColor = 17
.TwoColorGradient msoGradientHorizontal, 1
End With

复制代码

ning84 · 发表于 2025-4-12 19:37

microsoft learn powerpoint VBA TwoColorGradient msoGradientHorizontal, 3_360搜索 https://www.so.com/s?q=microsoft ... fad75c37be7eb0513c7

Sub SetTwoColorGradient()
Dim slide As Slide
Dim shape As Shape
Set slide = ActivePresentation.Slides(1)
' 创建矩形作为背景（或选择现有形状）
Set shape = slide.Shapes.AddShape(msoShapeRectangle, 0, 0, _
slide.Master.Width, slide.Master.Height)
With shape.Fill
.ForeColor.RGB = RGB(255, 0, 0) ' 渐变主色（如红色）
.BackColor.RGB = RGB(0, 0, 255) ' 渐变次色（如蓝色）
.TwoColorGradient msoGradientHorizontal, 3
.Visible = msoTrue
End With
shape.ZOrder msoSendToBack ' 将形状置于底层
End Sub

复制代码

2. 参数解析
msoGradientHorizontal：表示水平渐变方向，其他可选值包括：

plaintext
复制
msoGradientVertical
（垂直）
plaintext
复制
msoGradientDiagonalUp
（对角线向上）
plaintext
复制
msoGradientDiagonalDown
（对角线向下）
参数3：代表渐变变体类型，取值范围1-4：

1：主色占比25%/次色75%
2：主色50%/次色50%
3：主色75%/次色25%
4：主色中心辐射渐变
3. 高级应用技巧
动态尺寸适配：通过
plaintext
复制
slide.Master.Width
和
plaintext
复制
slide.Master.Height
获取幻灯片母版尺寸，确保背景全覆盖
颜色自定义：使用
plaintext
复制
RGB()
函数或
plaintext
复制
ObjectThemeColor
属性实现主题色绑定
多对象控制：结合
plaintext
复制
Shapes.Range
批量处理多个形状的渐变效果
4. 验证与调试建议
在VBA编辑器中按F8逐行调试
使用
plaintext
复制
Debug.Print shape.Fill.GradientVariant
验证渐变参数
通过
plaintext
复制
shape.Fill.Visible = msoFalse
临时隐藏效果进行对比测试
建议在实际操作前备份演示文稿，并通过Alt+F11打开VBA编辑器测试代码。如需扩展功能，可参考4中关于
plaintext
复制
Shapes
对象集合的操作方法。

ning84 · 发表于 2025-4-12 19:45

本帖最后由 ning84 于 2025-4-12 20:18 编辑

FillFormat.TwoColorGradient 方法 (PowerPoint) | Microsoft Learn  https://learn.microsoft.com/zh-c ... at.twocolorgradient

语法
表达式。TwoColorGradient (样式、变体)

表达一个代表 FillFormat 对象的变量。

参数
名称       必需/可选       数据类型       说明
样式       必需       MsoGradientStyle       渐变样式。
Variant       必需       Long       渐变变量。可以为 1 到 4，对应于“形状填充”选项卡上的“渐变”子选项卡上的四个变体。如果 Style 为 msoGradientFromTitle 或 msoGradientFromCenter，则此参数可以是 1 或 2。
示例
本示例向 myDocument 中添加一个具有双色渐变填充效果的矩形，并设置填充的前景色和背景色。

VB

复制
Set myDocument = ActivePresentation.Slides(1)

With myDocument.Shapes.AddShape(Type:=msoShapeRectangle, Left:=0, _
      Top:=0, Width:=40, Height:=80).Fill

.ForeColor.RGB = RGB(Red:=128, Green:=0, Blue:=0)
.BackColor.RGB = RGB(Red:=0, Green:=170, Blue:=170)
.TwoColorGradient Style:=msoGradientHorizontal, Variant:=1

End With

Function StarttimeToEndtimeForStreetsnapToTexBox(Shp As PowerPoint.Shape, DateArr, FontSize1, FontSize2)
Dim Str, EngDateStr, ChiDateStr
Dim N1, N2
EngDateStr = "Stree Snap From " & Format(DateArr(0), "h:mm") & " to " & Format(DateArr(1), "h:mm") & " on " & Format(DateArr(0), "mmmm d,yyyy")
ChiDateStr = Format(DateArr(0), "yyyy年m月d日h:mm") & "到" & Format(DateArr(1), "h:mm") & "的街拍"
With Shp
'If Shp.Type = 14 Then
.TextFrame2.TextRange.Text = ChiDateStr & vbCr & EngDateStr
N1 = Len(ChiDateStr)
.TextFrame.TextRange.Characters(0, N1).Font.Size = FontSize1
N2 = Len(ChiDateStr & vbCr & EngDateStr)
.TextFrame.TextRange.Characters(N1 + 1, N2).Font.Size = FontSize2
'End If
End With
End Function
Function ParseFilenameToDate(Str)
Dim Arr1, Arr2, Str1, Str2
Arr1 = Split(Str, "_")
Arr2 = Split(Arr1(1), "-")
Str1 = Arr1(0) & Arr2(0)
Str2 = Arr1(0) & Arr2(1)
Dim DateArr(1) As Date
DateArr(0) = Format(Str1, "0000/00/00 00:00")
DateArr(1) = Format(Str2, "0000/00/00 00:00")
ParseFilenameToDate = DateArr
End Function
''
Sub L1()
Dim Pres As PowerPoint.Presentation
Set Pres = Application.ActivePresentation
Dim PathName
With Pres
Debug.Print .Name, .Path, .FullName
End With
PathName = Pres.FullName
Dim DateArr, StaartEndStr
DateArr = ParseFilenameToDate(Left(Pres.Name, Len(Pres.Name) - 5))
Dim Sld As Slide, Slds As Slides, SldRng As SlideRange
Set Slds = Pres.Slides
Dim Shp As Shape, Shps As Shapes
Set SldRng = Application.ActiveWindow.Selection.SlideRange
Set Shps = SldRng.Shapes
StartEndStr = Left(Pres.Name, Len(Pres.Name) - 5)
StarttimeToEndtimeForStreetsnapToTexBox Shps("Txt1"), DateArr, 14, 8
StarttimeToEndtimeForStreetsnapToTexBox Shps("Txt2"), DateArr, 20, 15
For ii = 1 To Shps.Count
Set Shp = Shps(ii)
With Shp
Debug.Print " '" & .Name, .Type
Debug.Print Space(8) & "arr(" & ii - 1 & ")(0) =" & .Left
Debug.Print Space(8) & "arr(" & ii - 1 & ")(1) =" & .Top
Debug.Print Space(8) & "arr(" & ii - 1 & ")(2) =" & .Width
Debug.Print Space(8) & "arr(" & ii - 1 & ")(3) =" & .Height
End With
Next ii
End Sub
''
Sub Lll1()
Dim Pres As PowerPoint.Presentation
Set Pres = Application.ActivePresentation
Dim PathName
With Pres
Debug.Print .Name, .Path, .FullName
End With
PathName = Pres.FullName
Dim DateArr, StartEndStr
DateArr = ParseFilenameToDate(Left(Pres.Name, Len(Pres.Name) - 5))
Dim Sld As Slide, Slds As Slides, SldRng As SlideRange
Dim Txt1Shp As Shape, Txt2Shp As Shape, Pic1Shp As Shape, Pic2Shp As Shape
Dim ShpRng As ShapeRange
Set Slds = Pres.Slides
Dim Shp As Shape, Shps As Shapes
For Each Sld In Slds
Set Shps = Sld.Shapes
StartEndStr = Left(Pres.Name, Len(Pres.Name) - 5)
Set Txt1Shp = Shps("Txt1")
With Txt1Shp
StarttimeToEndtimeForStreetsnapToTexBox Txt1Shp, DateArr, 13, 10
.Left = 420
.Top = 50
.Width = 220
.Height = 100
.Select
With .TextFrame
.TextRange.ParagraphFormat.Alignment = ppAlignCenter
.AutoSize = ppAutoSizeNone
.VerticalAnchor = msoAnchorMiddle
End With
End With
Set Txt2Shp = Shps("Txt2")
With Txt2Shp
.Left = 420 + 260
.Top = 50
.Width = 220
.Height = 100
StarttimeToEndtimeForStreetsnapToTexBox Txt2Shp, DateArr, 13, 10
With .TextFrame
.TextRange.ParagraphFormat.Alignment = ppAlignCenter
.AutoSize = ppAutoSizeNone
.VerticalAnchor = msoAnchorMiddle
End With
With .Fill
.BackColor.RGB = RGB(118, 238, 198)
'.ForeColor.SchemeColor = ppShadow ' .ForeColor.SchemeColor = 15
.ForeColor.RGB = RGB(230, 230, 250)
'.BackColor.SchemeColor = ppShadow
.TwoColorGradient msoGradientHorizontal, 3
'.TwoColorGradient msoGradientHorizontal, 2
Debug.Print .GradientVariant
End With
.Select
Stop
Stop
End With
Set Pic1Shp = Shps(1)
With Pic1Shp
.Left = 50 ' Txt1Shp.Width
.Top = 50 'Txt2Shp.Height
.Width = 260
.Height = Pres.PageSetup.SlideHeight - 50 * 2
.Select
End With
Set Pic2Shp = Shps(2)
With Pic2Shp
.Left = 420
.Top = 200
.Width = 500
.Height = 300
.Select
End With
For ii = 1 To Shps.Count
Set Shp = Shps(ii)
With Shp
Debug.Print " '" & .Name, .Type
Debug.Print Space(8) & "arr(" & ii - 1 & ")(0) =" & .Left
Debug.Print Space(8) & "arr(" & ii - 1 & ")(1) =" & .Top
Debug.Print Space(8) & "arr(" & ii - 1 & ")(2) =" & .Width
Debug.Print Space(8) & "arr(" & ii - 1 & ")(3) =" & .Height
End With
Next ii
Next Sld
End Sub

复制代码

ning84 · 发表于 2025-4-13 11:50

本帖最后由 ning84 于 2025-4-13 19:23 编辑

学习，学习，再学习

Public Sub Add_Example()
Dim Pres As PowerPoint.Presentation
Dim pptSlide As Slide
Dim pptLayout As CustomLayout
Dim Sld As Slide, Slds As Slides
Set Slds = ActivePresentation.Slides
For ii = Slds.Count To 1 Step -1
Set Sld = Slds(ii)
Sld.Delete
Next ii
Dim oStyle As Integer, oVar As Integer
For ii = 1 To 20
'Set Sld = Slds.AddSlide(ii, ppLayoutBlank)
Set Sld = Slds.Add(Slds.Count + 1, ppLayoutBlank)
oStyle = oStyle + 1
oVar = oVar + 1
Sld.FollowMasterBackground = msoFalse
With Sld.Background.Fill
'.ForeColor.RGB = RGB(141 + ii, 238 + ii, 238 + ii)
'.BackColor.RGB = RGB(139, 129, 139)
.ForeColor.RGB = RGB(1 + ii * 10, 100 + ii * 3, 200 + ii)
'.BackColor.RGB = RGB(255, 0, 0)
'.BackColor.RGB = RGB(0, 0, 255)
.BackColor.RGB = RGB(0, 0, 0)
If oStyle > 7 Then
oStyle = 1
End If
If oVar > 4 Then
oVar = 1
End If
'.TwoColorGradient oStyle, oVar
.TwoColorGradient msoGradientHorizontal, 1
.Visible = msoCTrue
End With
Next ii
End Sub
''
Sub SetRandomSlideBackgroundColor()
Dim Sld As Slide
Dim Pres As PowerPoint.Presentation
Set Pres = Application.ActivePresentation
Dim R As Integer, G As Integer, B As Integer
Dim SldIndex As Integer
SldIndex = 2 '这里以第2张幻灯片为例，你可修改为所需幻灯片序号
Set Sld = Pres.Slides(SldIndex)
Sld.FollowMasterBackground = msoFalse
'在青色相关范围内生成随机RGB值
R = Int((127 - 0 + 1) * Rnd + 0) '青色相关范围内的R值范围（示例）
G = Int((255 - 100 + 1) * Rnd + 100) 'G值范围（示例）
B = Int((255 - 200 + 1) * Rnd + 200) 'B值范围（示例）
With Sld.Background.Fill
.Visible = msoTrue
.Solid
.ForeColor.RGB = RGB(R, G, B)
End With
End Sub
Sub dddd()
Dim Sld As Slide, Slds As Slides
Set Slds = Application.ActivePresentation.Slides
For ii = Slds.Count To 1 Step -1
Set Sld = Slds(ii)
Sld.Delete
Next ii
Dim R, G, B
For ii = 1 To 30
Set Sld = Slds.Add(ii, ppLayoutBlank)
Debug.Print Sld.Name
R = Int((127 - 0 + 1) * Rnd + 0) '青色相关范围内的R值范围（示例）
G = Int((255 - 100 + 1) * Rnd + 100) 'G值范围（示例）
B = Int((255 - 200 + 1) * Rnd + 200) 'B值范围（示例）
Sld.FollowMasterBackground = msoFalse
With Sld.Background.Fill
.Visible = msoCTrue
.ForeColor.RGB = RGB(R, G, B)
.BackColor.RGB = RGB(R, G, B)
.TwoColorGradient msoGradientHorizontal, 1
End With
Next ii
End Sub
Sub ddddd()
Dim Sld As Slide, Slds As Slides
Set Slds = Application.ActivePresentation.Slides
'删除原有幻灯片
For ii = Slds.Count To 1 Step -1
Set Sld = Slds(ii)
Sld.Delete
Next ii
For ii = 1 To 30
Set Sld = Slds.Add(ii, ppLayoutBlank)
Debug.Print Sld.Name
'生成ForeColor的随机RGB值
SldChangeTwoColorGradient Sld
Next ii
End Sub
Function SldChangeTwoColorGradient(Sld As Slide)
Dim R, G, B
Dim R2, G2, B2 '用于存储BackColor的RGB值
R = Int((127 - 0 + 1) * Rnd + 0)
G = Int((255 - 100 + 1) * Rnd + 100)
B = Int((255 - 200 + 1) * Rnd + 200)
'生成BackColor的随机RGB值，这里简单示例为在ForeColor基础上微调
R2 = Int((R + 50) / 2)
G2 = Int((G + 50) / 2)
B2 = Int((B + 50) / 2)
Sld.FollowMasterBackground = msoFalse
With Sld.Background.Fill
.Visible = msoCTrue
.ForeColor.RGB = RGB(R, G, B)
.BackColor.RGB = RGB(R2, G2, B2)
'.TwoColorGradient msoGradientHorizontal, Int((4 - 1 + 1) * Rnd + 1)
.TwoColorGradient Int((7 - 1 + 1) * Rnd + 1), Int((4 - 1 + 1) * Rnd + 1)
End With
End Function

复制代码

用户名		自动登录	找回密码
密码			免费注册

不会用TwoColorGradient和SchemeColor,必须学会RGB。

评分

浏览过的版块