家装计算公式最实用的ppt中公式颜色批量修改方法

2020年9月25日发(作者：童诗白)
v1.0 可编辑可修改
打开视图→模板，删去ppt底色。
回到普通视图模式，打开工具→宏→宏，在宏名处随便写几个字母，点击创建。
将自动生成语句全部删除，替换成如下程序，保存后关闭。
再打开打开工具→宏→宏，宏名处 为Recolor，点击运行后保存。（若未出现运行选项，打
开工具→宏→安全性，设置为中，重新打 开文件）
再次打印预览时可见公式。


' VBA cannot pass Shape into a function, so global var is used
Public sh As Shape

' The macro to excute
Sub ReColor()
Dim sld As Slide

For Each sld In
For Each sh In
Call ReColorSH
Next
Next
End Sub


Sub ReColorSH()
Dim ip As Integer ' point to the top of the i stack
Dim sp As Integer ' point to the top of the shape stack
Dim istk() As Integer ' the i stack, using dynamic array
1
v1.0 可编辑可修改
Dim sstk() As Shape ' the Shape stack, using dynamic array
Dim ssize As Integer ' the size of both stacks

ssize = 10
ReDim istk(ssize)
ReDim sstk(ssize)

ip = 0
sp = 0

Dim i As Integer
L2: If = msoGroup Then
i = 1
L1: 'pushS(sh)
sp = sp + 1
If sp > ssize Then
ssize = ssize + 1
ReDim Preserve istk(ssize)
ReDim Preserve sstk(ssize)
End If
Set sstk(sp) = sh
'----------
'pushI (i)
ip = ip + 1
istk(ip) = i
'----------
Set sh = (i)
2
v1.0 可编辑可修改
GoTo L2
L3: 'popI(i)
i = istk(ip)
ip = ip - 1
'----------
'popS(sh)
Set sh = sstk(sp)
sp = sp - 1
'----------
If i < Then
i = i + 1
GoTo L1
End If
ElseIf = msoEmbeddedOLEObject Then
If Left 8) = Then
= msoBlackWhiteBlack
End If
End If
If ip > 0 Then GoTo L3
End Sub

3